C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  LIBRARY FOR THE TOOL ISTAL
C
C----------------------------------------------------------
C
C  MAIN LOOP. READS IN THE COMMAND FILE ONE LINE AT A TIME
C  AND CHECKS TO SEE IF ISTAL IS REQUESTED TO PERFORM ANY
C  ACTIONS. THE COMMAND FILE IS ASSUMED TO CONTAIN A MIXTURE
C  OF TEXT AND ISTRF FORMAT COMMANDS. THE ISTRF FORMAT COMMAND
C  'CC' IS RECOGNIZED. ISTAL ACTIONS ARE INVOKED BY THE USE OF
C  THE ISTRF FORMAT COMMAND 'AL', EG: '.AL TOTALS=PROGRAM'
C
      SUBROUTINE SPOSTD(CMDFD)
 
      INTEGER CMDFD, I, STATUS, CC, STKPNT
      INTEGER BUFFER(134), PROMPT(5), STACK(10)
      INTEGER ZLOWER, ZGTCMD, OPEN, CTOI
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
      DATA PROMPT/97, 108, 58, 32, 129/
      DATA CC    /46/
 
      CALL KEYS
      STKPNT = 0
 
   10 CONTINUE
        IF (CMDFD .EQ. 0) THEN
          CALL ZPRMPT(PROMPT)
          BUFFER(1) = CC
          BUFFER(2) = 97
          BUFFER(3) = 108
          STATUS = ZGTCMD(BUFFER(4), CMDFD)
          IF((ZLOWER(BUFFER(4)) .EQ. 101 .AND.
     +        ZLOWER(BUFFER(5)) .EQ. 120).OR.
     +       (ZLOWER(BUFFER(4)) .EQ. 113 .AND.
     +        ZLOWER(BUFFER(5)) .EQ. 117))  THEN
            STATUS = -100
          ELSE IF(ZLOWER(BUFFER(4)) .EQ. 63 .AND.
     +            ZLOWER(BUFFER(5)) .EQ. 63)  THEN
            CALL DOHELP(BUFFER(6))
            GO TO 10
          ENDIF
        ELSE
          STATUS = ZGTCMD(BUFFER, CMDFD)
        ENDIF
        IF(STATUS .EQ. -1) RETURN
        IF(STATUS .EQ. -100) THEN
          CALL CLOSE(CMDFD)
          IF(STKPNT .EQ. 0) RETURN
          CMDFD  = STACK(STKPNT)
          STKPNT = STKPNT - 1
          GO TO 10
        ENDIF
 
        IF(BUFFER(1) .EQ. CC) THEN
          IF((ZLOWER(BUFFER(2)) .NE. 97) .OR.
     +       (ZLOWER(BUFFER(3)) .NE. 108)) THEN
            IF((BUFFER(2) .EQ. 99) .AND.
     +          (BUFFER(3) .EQ. 99)) THEN
              I = 4
              CALL SKIPBL(BUFFER, I)
              CC = 46
              IF(BUFFER(I) .NE. 129) CC = BUFFER(I)
 
            ELSE IF((BUFFER(2) .EQ. 114) .AND.
     +              (BUFFER(3) .EQ. 109)) THEN
              I = 4
              RMARG = CTOI(BUFFER, I)
              IF(RMARG .LE. 0) RMARG = 65
 
            ELSE IF((BUFFER(2) .EQ. 115) .AND.
     +              (BUFFER(3) .EQ. 111)) THEN
              I = 4
              CALL SKIPBL(BUFFER, I)
 
              IF(STKPNT .EQ. 10) THEN
                CALL REPORT('TOO MANY NESTED INCLUDES.', OUTFD)
              ELSE
                STKPNT = STKPNT + 1
                STACK(STKPNT) = CMDFD
                CMDFD = OPEN(BUFFER(I), 0)
                IF(CMDFD .EQ. -1) THEN
                  CALL REPORT('UNABLE TO OPEN INCLUDE FILE.', OUTFD)
                  IF(STKPNT .EQ. 0) RETURN
                  CMDFD  = STACK(STKPNT)
                  STKPNT = STKPNT - 1
                ENDIF
              ENDIF
              GO TO 10
 
            ENDIF
            CALL ZPTMES(BUFFER, OUTFD)
 
          ELSE
            I = 4
            CALL SKIPBL(BUFFER, I)
            IF(OUTFD .NE. 1) THEN
              IF(CC.NE.46) THEN
                CALL PUTCH(CC, OUTFD)
                CALL ZMESS('cc ...', OUTFD)
              ENDIF
            ENDIF
            CALL DOCMND(BUFFER(I))
            IF(OUTFD .NE. 1) THEN
              IF(CC.NE.46) THEN
                CALL ZCHOUT('..cc .', OUTFD)
                CALL PUTCH(CC, OUTFD)
                CALL PUTCH(10, OUTFD)
              ENDIF
            ENDIF
 
          ENDIF
 
        ELSE
          CALL ZPTMES(BUFFER, OUTFD)
 
        ENDIF
 
      GO TO 10
 
      END
C---------------------------------------------------------------
C
C  PUT OUT MINIMAL HELP INFORMATION
C
      SUBROUTINE DOHELP(BUFFER)
 
      INTEGER BUFFER(*)
      INTEGER MAXLIN, I
      PARAMETER (MAXLIN = 24)
      CHARACTER*52 L(MAXLIN)
C                 ..../..../..../..../..../..../..../..../..../..../..
      DATA L( 1)/'ANNOtated = <filename>.'/
      DATA L( 2)/'ASsertions [= <expression>].'/
      DATA L( 3)/'CAllgraph [= <filename>|(<filename>)].'/
      DATA L( 4)/'COmmon usage [= <filename>|(<filename>)].'/
      DATA L( 5)/'DEbug [= YES|NO].'/
      DATA L( 6)/'DYnamic [= <expression>].'/
      DATA L( 7)/'EXit.'/
      DATA L( 8)/'FOlding [= YES|NO].'/
      DATA L( 9)/'FUllxreference [= <filename>|(<filename>)].'/
      DATA L(10)/'Intrinsics [= YES|NO].'/
      DATA L(11)/'Listing [= NO|list].'/
      DATA L(12)/'Run time = <filename>.'/
      DATA L(13)/'SEgments [= <expression>].'/
      DATA L(14)/'STatic [= <expression>].'/
      DATA L(15)/'SUmmary = <filename>.'/
      DATA L(16)/'SYmbol info [= <expression>].'/
      DATA L(17)/'TAble load [= <filename>|(<filename>)].'/
      DATA L(18)/'TOtals [= <expression>].'/
      DATA L(19)/'Verbose [= YES|NO].'/
      DATA L(20)/'QUit.'/
      DATA L(21)/'Warnings [= <expression>].'/
      DATA L(22)/'Xreference [= <filename>|(<filename>)].'/
      DATA L(23)/'Zero-segs [= <expression>].'/
      DATA L(24)/'??.'/
C                 ..../..../..../..../..../..../..../..../..../..../..
 
      DO 10 I =  1, MAXLIN
        CALL ZMESS(L(I), 1)
   10 CONTINUE
 
      END
C---------------------------------------------------------------
C
C  PUT A PROBLEM REPORT INTO THE OUTPUT DOCUMENT
C
      SUBROUTINE REPORT(STRING, FD)
 
      INTEGER        FD
      CHARACTER *(*) STRING
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
      REPRTS = REPRTS + 1
      IF(OUTFD .NE. 1) CALL ZMESS ('..sp.',      FD)
      CALL ZCHOUT('  **ISTAL: .', FD)
      CALL ZMESS (STRING,         FD)
      CALL COMPLT(FD)
 
      END
C---------------------------------------------------------------
C
C  ROUTINE TO IDENTIFY THE USERS REQUEST AND CALL THE APPROPRIATE
C  ROUTINES TO EXECUTE IT.
C
      SUBROUTINE DOCMND(BUFFER)
 
      INTEGER C, C2, STATUS, IJUNK
      INTEGER BUFFER(*), JUNK(134), BODY(134)
      INTEGER ZLOWER, GETXRF, ZSPLIT
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
      SAVE
 
      C  = ZLOWER(BUFFER(1))
      C2 = ZLOWER(BUFFER(2))
C
C  CALLGRAPH
C
      IF((C .EQ. 99).AND.(C2 .EQ. 97)) THEN
        IF(GETXRF(BUFFER) .EQ. -2) THEN
          CALL GRAPH
        ELSE
          CALL REPORT('FAILURE IN CALLGRAPH COMMAND.', OUTFD)
        ENDIF
C
C  XREF
C
      ELSE IF(C .EQ. 120) THEN
        IF(GETXRF(BUFFER) .EQ. -2) THEN
          CALL LIST (-3)
        ELSE
          CALL REPORT('FAILURE IN XREFERENCE COMMAND.', OUTFD)
        ENDIF
C
C  FULLXREF
C
      ELSE IF((C .EQ. 102) .AND. (C2 .EQ. 117)) THEN
        IF(GETXRF(BUFFER) .EQ. -2) THEN
          CALL LIST (-2)
        ELSE
          CALL REPORT('FAILURE IN FULLXREFERENCE COMMAND.', OUTFD)
        ENDIF
C
C  TABLE LOAD
C
      ELSE IF((C .EQ. 116) .AND. (C2 .EQ. 97)) THEN
        IF(GETXRF(BUFFER) .NE. -2) THEN
          CALL REPORT('FAILURE IN SYMBOL TABLE LOAD COMMAND.', OUTFD)
        ENDIF
C
C  SYMBOLS AND WARNINGS
C
      ELSE IF((C .EQ. 115) .AND. (C2 .EQ. 121)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        CALL VLIST (-2, BODY)
      ELSE IF(C .EQ. 119) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        CALL VLIST (-3, BODY)
C
C  COMMON USAGE
C
      ELSE IF((C .EQ. 99).AND.(C2 .EQ. 111)) THEN
        IF(GETXRF(BUFFER) .EQ. -2) THEN
          CALL COMOUT
        ELSE
          CALL REPORT('FAILURE IN COMMON USAGE COMMAND.', OUTFD)
        ENDIF
C
C  FILE OPENING: ANNOTATED, HISTORY, SINGLE, SUMMARY AND TRACE
C
      ELSE IF((C .EQ. 97).AND.(C2 .EQ. 110)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, ANNNAM)
        ANNFD = -1
      ELSE IF(C .EQ. 114) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, DYNNAM)
        DYNFD = -1
      ELSE IF((C .EQ. 115).AND.(C2 .EQ. 117)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, SUMNAM)
        SUMFD = -1
C
C  ASSERTIONS
C
      ELSE IF((C .EQ. 97).AND.(C2 .EQ. 115)) THEN
        CALL RSTATS(STATUS)
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(STATUS .EQ. -2) THEN
          CALL GETDYN(STATUS)
          IF(STATUS .EQ. -2) THEN
            CALL ASSLST(BODY)
          ELSE
            CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
          ENDIF
        ELSE
          CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
        ENDIF
C
C  DYNAMIC
C
      ELSE IF((C .EQ. 100) .AND. (C2 .EQ. 121)) THEN
        CALL RSTATS(STATUS)
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(STATUS .EQ. -2) THEN
          CALL GETDYN(STATUS)
          IF(STATUS .EQ. -2) THEN
            CALL DYNLST(BODY)
          ELSE
            CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
          ENDIF
        ELSE
          CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
        ENDIF
C
C  SEGMENTS
C
      ELSE IF((C .EQ. 115).AND.(C2 .EQ. 101)) THEN
        CALL RSTATS(STATUS)
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(STATUS .EQ. -2) THEN
          CALL GETDYN(STATUS)
          IF(STATUS .EQ. -2) THEN
            CALL SEGLST(BODY, .TRUE.)
          ELSE
            CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
          ENDIF
        ELSE
          CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
        ENDIF
C
C  ZERO SEGMENTS
C
      ELSE IF(C .EQ. 122) THEN
        CALL RSTATS(STATUS)
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(STATUS .EQ. -2) THEN
          CALL GETDYN(STATUS)
          IF(STATUS .EQ. -2) THEN
            CALL SEGLST(BODY, .FALSE.)
          ELSE
            CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
          ENDIF
        ELSE
          CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
        ENDIF
C
C  LISTING
C
      ELSE IF(C .EQ. 108) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
 
        IF(BODY(1) .EQ. 129) THEN
          CALL RSTATS(STATUS)
          CALL GETDYN(STATUS)
        ELSE
          STATUS = -2
        ENDIF
        IF(STATUS .EQ. -2) THEN
          CALL DOLIST(BODY)
        ELSE
          CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
        ENDIF
C
C  STATIC
C
      ELSE IF((C .EQ. 115).AND.(C2 .EQ. 116)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        CALL RSTATS(STATUS)
        IF(STATUS .EQ. -2) THEN
          CALL PROLST(BODY)
        ELSE
          CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
        ENDIF
C
C  TOTALS
C
      ELSE IF((C .EQ. 116) .AND.(C2 .EQ. 111)) THEN
        CALL RSTATS(STATUS)
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(STATUS .EQ. -2) THEN
          CALL GETDYN(STATUS)
          IF(STATUS .EQ. -2) THEN
            CALL TOTLST(BODY)
          ELSE
            CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
          ENDIF
        ELSE
          CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
        ENDIF
C
C  VERBOSE SWITCH
C
      ELSE IF(C .EQ. 118) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(ZLOWER(BODY(1)) .EQ. 110) THEN
          VERBOS = .FALSE.
        ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
          VERBOS = .TRUE.
        ELSE
          VERBOS = .NOT. VERBOS
        ENDIF
C
C  DEBUG SWITCH
C
      ELSE IF((C .EQ. 100) .AND. (C2 .EQ. 101)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(ZLOWER(BODY(1)) .EQ. 110) THEN
          DEBUG = .FALSE.
        ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
          DEBUG = .TRUE.
        ELSE
          DEBUG = .NOT. DEBUG
        ENDIF
C
C  PROCEDURE SWITCH
C
      ELSE IF(C .EQ. 112) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(ZLOWER(BODY(1)) .EQ. 110) THEN
           DECLIE = .FALSE.
        ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
           DECLIE = .TRUE.
        ELSE
           DECLIE = .NOT. DECLIE
        ENDIF
 
C
C  CASE FOLDING SWITCH
C
      ELSE IF((C .EQ. 102) .AND. (C2 .EQ. 111)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(ZLOWER(BODY(1)) .EQ. 110) THEN
          CASFOL = .FALSE.
        ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
          CASFOL = .TRUE.
        ELSE
          CASFOL = .NOT. CASFOL
        ENDIF
C
C  INTRINSICS SWITCH
C
      ELSE IF((C .EQ. 105) .AND.(C2 .EQ. 110)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(ZLOWER(BODY(1)) .EQ. 110) THEN
          INTRIN = .FALSE.
        ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
          INTRIN = .TRUE.
        ELSE
          INTRIN = .NOT. INTRIN
        ENDIF
C
C  IMPLICIT SWITCH
C
      ELSE IF((C .EQ. 105) .AND.(C2 .EQ. 109)) THEN
        IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
        IF(ZLOWER(BODY(1)) .EQ. 110) THEN
          IMPLI = .FALSE.
        ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
          IMPLI = .TRUE.
        ELSE
          IMPLI = .NOT. IMPLI
        ENDIF
C
C  UNRECOGNIZED COMMAND
C
      ELSE
        CALL REPORT('UNRECOGNIZED COMMAND.', OUTFD)
 
      ENDIF
 
      END
C----------------------------------------------------------------
C
C  PUT EVEYTHING BACK TO THE 'NORMAL' FORM. THIS ROUTINE IS NORMALLY
C  CALLED AT THE END OF EACH OUTPUT SECTION TO RETURN THE OUTPUT
C  STREAM TO A KNOWN STATE (NOT NECESSARILY THE ORIGINAL STATE!).
C
      SUBROUTINE COMPLT(FD)
 
      INTEGER FD
 
      CALL PUTCH(10, FD)
      IF(FD .NE. 1) THEN
        CALL ZMESS('..fi.', FD)
        CALL ZMESS('..ju.', FD)
        CALL ZMESS('..in 0.', FD)
        CALL ZMESS('..ce 0.', FD)
      ENDIF
 
      END
C----------------------------------------------------------------
C
C  PRODUCE A LISTING BY READING THE ANNOTATED LISTING FILE AND
C  REPLACING ALL THE ASSERTION AND SEGMENT NUMBERS WITH THEIR
C  EXECUTION FREQUENCIES.
C
      SUBROUTINE DOLIST(COMAND)
 
      INTEGER I, STATUS, JUNK, START, END
      INTEGER COMAND(*), BUFFER(134), ID(3), BODY(134)
      INTEGER OPEN, GETLIN, ZLOWER, ZSEDID, CTOI, TYPE
      LOGICAL SEGFLG
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      IF(ZLOWER(COMAND(1)) .EQ. 108) THEN
        CALL DOLST2(COMAND)
        RETURN
      ENDIF
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following listing of the instrumented.',OUTFD)
        CALL ZMESS('program has been annotated with the segment.',OUTFD)
        CALL ZMESS('execution frequencies a'//'nd assertion.',OUTFD)
        CALL ZMESS('failure counts taken from the file:.',OUTFD)
        CALL ZPTMES(DYNNAM,OUTFD)
      ENDIF
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS ('..nf.', OUTFD)
        CALL ZMESS ('..nj.', OUTFD)
        CALL ZMESS ('..in 6.', OUTFD)
      ENDIF
 
      ANNFD = OPEN(ANNNAM, 0)
      IF(ANNFD .EQ. -1) THEN
        CALL REPORT('UNABLE TO OPEN ANNOTATED LISTING FILE.', OUTFD)
        RETURN
      ENDIF
C
C  PROCESS EXECUTION LOOP. READ IN THE FILE LOOKING FOR ERRORS OR THE
C  END OF FILE, WHICH ARE PROCESSED IMMEDIATLY. LINES OF INPUT ARE
C  OUTPUT AGAIN IMMEDIATLY (OFFSET BY A LEFT MARGIN) UNLESS THEY ARE
C  AN 'AN' SOURCE EMBEDDED DIRECTIVE.
C
   10 CONTINUE
 
        STATUS = GETLIN(BUFFER, ANNFD)
        BUFFER(RMARG - 6) = 10
        BUFFER(RMARG - 5)  = 129
 
        IF(STATUS .EQ. -1) THEN
          CALL REPORT('ERROR IN READING ANNOTATED LISTING FILE.', OUTFD)
          RETURN
 
        ELSE IF(STATUS .EQ. -100) THEN
          CALL CLOSE(ANNFD)
          CALL COMPLT(OUTFD)
          RETURN
 
        ELSE
          IF(ZSEDID(BUFFER, JUNK, ID, BODY) .EQ. -2) THEN
            IF((ZLOWER(ID(1)) .EQ. 97) .AND.
     +         (ZLOWER(ID(2)) .EQ. 110)) THEN
              I = 1
              SEGFLG = .TRUE.
              START = CTOI(BODY, I)
              CALL SKIPBL(BODY, I)
              IF(BODY(I) .EQ. 10) THEN
                END = START
              ELSE IF(ZLOWER(BODY(I)) .EQ. 97) THEN
                SEGFLG = .FALSE.
                END    = START
              ELSE
   30           CONTINUE
                IF(ZLOWER(BODY(I)) .EQ. 116) THEN
                  I = I + 2
                  END = CTOI(BODY, I)
                ELSE IF(TYPE(BODY(I)) .EQ. 2) THEN
                  END = CTOI(BODY, I)
                ENDIF
                CALL SKIPBL(BODY, I)
                IF(BODY(I) .NE. 10) GO TO 30
              ENDIF
 
C         ....OUTPUT THE COUNT INFORMATION
              IF(END .LT. START) END = START
              DO 20 I = START, END
                IF(OUTFD .NE. 1) CALL ZMESS('..ti 0.', OUTFD)
                IF(SEGFLG) THEN
                  CALL ZCHOUT('SEGMENT .', OUTFD)
                  CALL ZPTINT(I, 1, OUTFD)
                  CALL ZCHOUT(': .', OUTFD)
                  IF(COMAND(1) .EQ. 129) CALL ZPTINT(SEGS(I), 1, OUTFD)
                  CALL PUTCH(10, OUTFD)
                ELSE
                  CALL ZCHOUT('ASSERTION .', OUTFD)
                  CALL ZPTINT(I, 1, OUTFD)
                  CALL ZCHOUT(': .', OUTFD)
                  IF(COMAND(1) .EQ. 129) CALL ZPTINT(ASRTS(I), 1, OUTFD)
                  CALL PUTCH(10, OUTFD)
                ENDIF
   20         CONTINUE
 
            ELSE
              IF(OUTFD .EQ. 1) CALL ZOBLNK(6, OUTFD)
              CALL PUTLIN(BUFFER, OUTFD)
 
            ENDIF
 
          ELSE
            IF(OUTFD .EQ. 1) CALL ZOBLNK(6, OUTFD)
            CALL PUTLIN(BUFFER, OUTFD)
 
          ENDIF
        ENDIF
 
      GO TO 10
 
      END
C----------------------------------------------------------------
C
C  PRODUCE A LISTING OF THE DOCUMENTATION SECTIONS OF A PROGRAM UNIT
C
      SUBROUTINE DOLST2(COMAND)
 
      INTEGER STATUS, JUNK
      INTEGER COMAND(*), BUFFER(134), ID(3), BODY(134)
      INTEGER OPEN, GETLIN, ZLOWER, ZSEDID, ZSEDTY
      LOGICAL LSTFLG
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
      SAVE
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following listing is of the.',OUTFD)
        CALL ZMESS('program unit embedded documentation.',OUTFD)
        CALL ZMESS('found in file (this information can.',OUTFD)
        CALL ZMESS('also be recovered using ISTDX): .',OUTFD)
        CALL ZPTMES(DYNNAM,OUTFD)
      ENDIF
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS ('..nf.', OUTFD)
        CALL ZMESS ('..nj.', OUTFD)
      ENDIF
 
      LSTFLG = .FALSE.
      ANNFD = OPEN(ANNNAM, 0)
      IF(ANNFD .EQ. -1) THEN
        CALL REPORT('UNABLE TO OPEN ANNOTATED LISTING FILE.', OUTFD)
        RETURN
      ENDIF
C
C  PROCESS EXECUTION LOOP. READ IN THE FILE LOOKING FOR ERRORS OR THE
C  END OF FILE, WHICH ARE PROCESSED IMMEDIATLY. LINES OF INPUT ARE
C  OUTPUT AGAIN IMMEDIATLY UNLESS THEY ARE A 'DX' SOURCE EMBEDDED DIRECTIVE.
C
   10 CONTINUE
 
        STATUS = GETLIN(BUFFER, ANNFD)
 
        IF(STATUS .EQ. -1) THEN
          CALL REPORT('ERROR IN READING ANNOTATED LISTING FILE.', OUTFD)
          RETURN
 
        ELSE IF(STATUS .EQ. -100) THEN
          CALL CLOSE(ANNFD)
          CALL COMPLT(OUTFD)
          RETURN
 
        ELSE
          IF(ZSEDID(BUFFER, JUNK, ID, BODY) .EQ. -2) THEN
            IF((ZLOWER(ID(1)) .EQ. 100) .AND.
     +         (ZLOWER(ID(2)) .EQ. 120)) THEN
              IF(ZSEDTY(BODY, STATUS) .NE. 112) THEN
                IF(STATUS .EQ. -2) THEN
                  LSTFLG = .TRUE.
                  CALL ZMESS('..sp.', OUTFD)
                ELSE IF(STATUS .EQ. -3 ) THEN
                  LSTFLG = .FALSE.
                ENDIF
              ENDIF
            ENDIF
          ELSE
            IF(LSTFLG) THEN
             IF(BUFFER(1) .EQ. 99 .OR. BUFFER(1) .EQ. 67 .OR.
     +          BUFFER(1) .EQ. 42) CALL PUTLIN(BUFFER(2), OUTFD)
            ENDIF
          ENDIF
 
        ENDIF
 
      GO TO 10
 
      END
C----------------------------------------------------------------
C
C  PRODUCE SEGMENT EXECUTION INFORMATION
C
      SUBROUTINE SEGLST(COMAND, FLAG)
 
      INTEGER I, JUNK, FIRST
      INTEGER COMAND(*)
      INTEGER ZSETP, ZPFIND
      LOGICAL FLAG
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      JUNK = ZSETP(COMAND, CASFOL)
 
      IF(FLAG) THEN
        IF(VERBOS) THEN
          CALL PUTCH(10, OUTFD)
          CALL ZMESS('The following table shows the execution.',OUTFD)
          CALL ZMESS('frequencies for the various segments...',OUTFD)
          CALL ZMESS('The first count for each program unit.',OUTFD)
          CALL ZMESS('is also the invocation frequency for.',OUTFD)
          CALL ZMESS('that unit...',OUTFD)
        ENDIF
 
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) THEN
          CALL ZMESS('..nf.', OUTFD)
          CALL ZMESS('..nj.', OUTFD)
          CALL ZMESS('..ce.', OUTFD)
          CALL ZMESS('..ul 3.', OUTFD)
        ENDIF
        CALL ZMESS ('SEGMENT EXECUTION FREQUENCIES.', OUTFD)
        CALL PUTCH(10, OUTFD)
        CALL ZMESS(
     +'NAME  FIRST SEG       EXECUTION FREQUENCIES.', OUTFD)
        IF(OUTFD .EQ. 1) CALL ZMESS(
     +'-------------------------------------------.', OUTFD)
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) THEN
          CALL ZMESS('..in 15.', OUTFD)
          CALL ZMESS('..fi.', OUTFD)
        ENDIF
      ELSE
        IF(VERBOS) THEN
          CALL PUTCH(10, OUTFD)
          CALL ZMESS('The following table shows those segments.',OUTFD)
          CALL ZMESS('which have n'//'ot been executed at all...',OUTFD)
        ENDIF
 
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) THEN
          CALL ZMESS('..nf.', OUTFD)
          CALL ZMESS('..nj.', OUTFD)
          CALL ZMESS('..ce.', OUTFD)
          CALL ZMESS('..ul 3.', OUTFD)
        ENDIF
        CALL ZMESS ('SEGMENTS NOT EXECUTED.', OUTFD)
        CALL PUTCH(10, OUTFD)
        CALL ZMESS(
     +'NAME  FIRST SEG       SEGMENTS NOT EXECUTED.', OUTFD)
        IF(OUTFD .EQ. 1) CALL ZMESS(
     +'-------------------------------------------.', OUTFD)
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) THEN
          CALL ZMESS('..in 15.', OUTFD)
          CALL ZMESS('..fi.', OUTFD)
        ENDIF
      ENDIF
 
      DO 10 I = 1, NUMROU
        IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
          IF(FIRST .EQ. 1) THEN
            IF(FLAG) CALL DOSEGS(I)
            IF(.NOT. FLAG) CALL DOSEG0(I)
          ENDIF
        ENDIF
   10 CONTINUE
 
      CALL COMPLT(OUTFD)
 
      END
C----------------------------------------------------------------
C
C  PRODUCE ASSERTION EXECUTION INFORMATION
C
      SUBROUTINE ASSLST(COMAND)
 
      INTEGER I, JUNK, FIRST
      INTEGER COMAND(*)
      INTEGER ZSETP, ZPFIND
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      JUNK = ZSETP(COMAND, CASFOL)
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following table shows the failure.',OUTFD)
        CALL ZMESS('frequencies for the various assertions...',OUTFD)
      ENDIF
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..nf.', OUTFD)
        CALL ZMESS('..nj.', OUTFD)
      ENDIF
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..ce.', OUTFD)
        CALL ZMESS('..ul 3.', OUTFD)
      ENDIF
      CALL ZMESS ('ASSERTION FAILURE FREQUENCIES.', OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL ZMESS(
     +'NAME  FIRST ASS       FAILURE FREQUENCIES.', OUTFD)
      IF(OUTFD .EQ. 1) CALL ZMESS(
     +'-----------------------------------------.', OUTFD)
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..in 15.', OUTFD)
        CALL ZMESS('..fi.', OUTFD)
      ENDIF
 
      DO 10 I = 1, NUMROU
        IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
          IF(FIRST .EQ. 1) CALL DOASRT(I)
        ENDIF
   10 CONTINUE
 
      CALL COMPLT(OUTFD)
 
      END
C------------------------------------------------------
C
C  OUTPUT THE SEGMENT EXECUTION FREQUENCIES FOR A SINGLE
C  PROGRAM UNIT.
C
      SUBROUTINE DOSEGS(ROUTIN)
 
      INTEGER ROUTIN, I, LIMIT, J, FIRST
      INTEGER GETLIM
      INTRINSIC MOD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      IF(OUTFD .NE. 1) CALL ZMESS('..ti -15.', OUTFD)
      CALL PUTLIN(NAMES(1, ROUTIN), OUTFD)
 
      CALL ZCHOUT(' (.', OUTFD)
      IF(GETLIM(ROUTIN, FIRST, LIMIT) .EQ. 0) THEN
        CALL ZMESS('none).', OUTFD)
        RETURN
      ENDIF
      CALL ZPTINT(FIRST, 4, OUTFD)
      CALL ZCHOUT(') :.', OUTFD)
      J = 0
 
      DO 10 I = FIRST, LIMIT
        CALL ZPTINT(SEGS(I), 8, OUTFD)
        J = J + 1
        IF(I .NE. LIMIT)  CALL ZCHOUT(', .', OUTFD)
        IF((I .EQ. LIMIT) .OR. (MOD(J, 5) .EQ. 0)) THEN
          CALL PUTCH(10, OUTFD)
          IF((I .NE. LIMIT) .AND. (OUTFD .EQ. 1))
     +       CALL ZOBLNK(15, OUTFD)
        ENDIF
   10 CONTINUE
 
      END
C------------------------------------------------------
C
C  OUTPUT THE SEGMENTS WHICH HAVE NOT BEEN EXECUTED FOR
C  A SINGLE PROGRAM UNIT.
C
      SUBROUTINE DOSEG0(ROUTIN)
 
      INTEGER ROUTIN, I, LIMIT, J, FIRST
      INTEGER GETLIM
      INTRINSIC MOD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      IF(OUTFD .NE. 1) CALL ZMESS('..ti -15.', OUTFD)
      CALL PUTLIN(NAMES(1, ROUTIN), OUTFD)
 
      CALL ZCHOUT(' (.', OUTFD)
      IF(GETLIM(ROUTIN, FIRST, LIMIT) .EQ. 0) THEN
        CALL ZMESS('none).', OUTFD)
        RETURN
      ENDIF
      CALL ZPTINT(FIRST, 4, OUTFD)
      CALL ZCHOUT(') :.', OUTFD)
      J = 0
 
      DO 10 I = FIRST, LIMIT
        IF(SEGS(I) .EQ. 0) THEN
          CALL ZPTINT(I, 8, OUTFD)
          J = J + 1
          IF(I .NE. LIMIT)  CALL ZCHOUT(', .', OUTFD)
        ENDIF
        IF((I .EQ. LIMIT) .OR. (MOD(J,5).EQ.0.AND.J.NE.0)) THEN
          CALL PUTCH(10, OUTFD)
        IF((I .NE. LIMIT) .AND. (OUTFD .EQ. 1))
     +       CALL ZOBLNK(15, OUTFD)
        ENDIF
   10 CONTINUE
 
      END
C------------------------------------------------------
C
      SUBROUTINE DOASRT(ROUTIN)
 
      INTEGER ROUTIN, I, LIMIT
      INTRINSIC MOD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      IF(ROUTIN .EQ.NUMROU) THEN
        LIMIT = NOASRT
      ELSE
        LIMIT = ISTASG(ROUTIN+1) - 1
      ENDIF
 
      IF(OUTFD .NE. 1) CALL ZMESS('..ti -15.', OUTFD)
      CALL PUTLIN(NAMES(1, ROUTIN), OUTFD)
      CALL ZCHOUT(' (.', OUTFD)
      IF(LIMIT - ISTASG(ROUTIN) .LT. 0) THEN
        CALL ZMESS('none).', OUTFD)
        RETURN
      ENDIF
      CALL ZPTINT(ISTASG(ROUTIN), 4, OUTFD)
      CALL ZCHOUT(') :.', OUTFD)
 
      DO 10 I = ISTASG(ROUTIN), LIMIT
        CALL ZPTINT(ASRTS(I), 8, OUTFD)
        IF(I .NE. LIMIT)  CALL ZCHOUT(', .', OUTFD)
        IF((I .EQ. LIMIT) .OR. (MOD(I, 5) .EQ. 0)) THEN
          CALL PUTCH(10, OUTFD)
          IF((I .NE. LIMIT) .AND. (OUTFD .EQ. 1))
     +       CALL ZOBLNK(15, OUTFD)
        ENDIF
   10 CONTINUE
 
      END
C--------------------------------------------------------------
C
C  GET THE INFORMATION REQUIRED TO PRODUCE XREFERENCE LISTING.
C  THIS CONSISTS OF READING IN THE SYMBOL TABLE(S) AND PLACING
C  THE INFORMATION IN THE INTERNAL ARRAYS.
C
      INTEGER FUNCTION GETXRF(BUFFER)
 
      INTEGER REFFD, JUNK, POINT, SYMFD, STATUS
      LOGICAL REFFLG
      INTEGER BUFFER(*), RHS(134), LHS(134), NAME(81)
      INTEGER OPEN, INDEXX, ZTBINT, ZTBTYP, ZGTCMD, ZSPLIT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 307200)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
 
      JUNK = ZSPLIT(BUFFER, LHS, RHS)
C
C  IF THE LINE WAS 'XREF = ' THEN USE THE DEFAULT VALUES (IE: THOSE
C  ALREADY IN THE TABLE).
C
      IF(RHS(1) .EQ. 129) THEN
        GETXRF = ZTBTYP(ARRAY, JUNK, JUNK, JUNK, JUNK)
        RETURN
      ENDIF
C
C  CHECK THE NAME, A NAME IN THE FORMAT 'NAME' IS THE NAME OF A SYMBOL
C  TABLE FILE. A NAME IN THE FORMAT '(NAME)' IS A FILE CONTAINING A
C  LIST OF NAMES OF SYMBOL TABLE FILES.
C
      IF(RHS(1) .EQ. 40) THEN
        POINT  = INDEXX(RHS, 41)
        IF(POINT .NE. 0) RHS(POINT) = 129
        REFFLG = .TRUE.
        REFFD  = OPEN(RHS(2), 0)
        STATUS = ZGTCMD(NAME, REFFD)
 
      ELSE
        REFFLG = .FALSE.
        CALL SCOPY(RHS, 1, NAME, 1)
        STATUS = -2
 
      ENDIF
C
C  INITIALISE THE TABLE STRUCTURES.
C
      IF(ZTBINT(VARARR, MAXVAR, 8) .EQ. -1) CALL
     +          ERROR('UNABLE TO SET UP VAR TABLE.')
      NUMCLD = 0
      NUMCLR = 0
      IF(ZTBINT(ARRAY, MAXSIZ, 4) .EQ. -1) CALL
     +          ERROR('UNABLE TO SET UP XREF TABLE.')
      NUMCOM = 0
      IF(ZTBINT(COMARR, MAXSIZ, 12) .EQ. -1) CALL
     +          ERROR('UNABLE TO SET UP COMMON TABLE.')
C
C  RECOVER EACH SYMBOL TABLE IN TURN AND PROCESS IT.
C
   10 CONTINUE
        IF(STATUS .EQ. -1) THEN
          IF(REFFLG) CALL CLOSE(REFFD)
          GETXRF = -1
          RETURN
 
        ELSE IF(STATUS .EQ. -100) THEN
          IF(REFFLG) CALL CLOSE(REFFD)
          GETXRF = -2
          RETURN
 
        ELSE
          SYMFD = OPEN(NAME, 0)
          IF(SYMFD .EQ. -1) THEN
            CALL REPORT('SYMBOL TABLE OPEN FAILURE.', OUTFD)
            GETXRF = -1
            RETURN
          ENDIF
          CALL ZYINSY(SYMFD)
          CALL CLOSE (SYMFD)
          CALL XINFO
 
        END IF
 
        IF(REFFLG) THEN
          STATUS = ZGTCMD(NAME, REFFD)
        ELSE
          STATUS = -100
        ENDIF
 
      GO TO 10
 
      END
C---------------------------------------------------------------
C
C  SUBROUTINE TO PROCESS THE CURRENT SYMBOL TABLE
C
      SUBROUTINE XINFO
 
      INTEGER I, LENP, PU, NSYMS, SDTYPE
      INTEGER PUNAME(34), EXNAME(34), SYMIDX(5003),
     +        SYMBOL(8,5003)
      INTEGER LENGTH, ZIAND
      LOGICAL BDFLAG, INTFLG
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
      PU = 1
 
   10 CONTINUE
 
        CALL ZYGSSI(SYMIDX, NSYMS, PU)
        BDFLAG = .FALSE.
 
        IF (NSYMS .EQ. 0) RETURN
        DO 20 I =1, NSYMS
          CALL ZYGTSY(SYMIDX(I), SYMBOL(1,I))
          SDTYPE = SYMBOL(4, I)
          IF(SYMBOL(1, I) .EQ. 4) THEN
            CALL ZYGTST(SYMBOL(2, I), PUNAME)
            LENP = LENGTH(PUNAME) + 1
            IF (LENP.GT.34) CALL ERROR('Program-unit name too long')
            IF(CASFOL) CALL ZTOCAP(PUNAME)
            IF(SDTYPE .EQ. -2) THEN
              BDFLAG = .TRUE.
            ELSE
              CALL XRADDP(PUNAME, LENP)
            ENDIF
          ENDIF
   20   CONTINUE
 
        DO 30 I = 1, NSYMS
          CALL ZYGTST(SYMBOL(2, I), EXNAME)
          IF (LENGTH(EXNAME).GE.34)
     +      CALL ERROR('External reference name too long')
          IF(CASFOL) CALL ZTOCAP(EXNAME)
 
          IF(SYMBOL(1, I) .EQ. 7) THEN
            IF(BDFLAG) CALL ERROR
     +        ('ILLEGAL PROCEDURE REFERENCE IN BLOCK DATA.')
            IF(ZIAND(SYMBOL(6,I), 4096) .NE. 0) THEN
              INTFLG = .TRUE.
            ELSE
              INTFLG = .FALSE.
            ENDIF
            IF(.NOT. INTRIN .AND. INTFLG) GO TO 30
            CALL XRADD(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1, INTFLG)
            CALL XVADD(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1, BDFLAG,
     +                 SYMBOL(1, I))
 
          ELSE IF(SYMBOL(1, I) .EQ. 9) THEN
            IF(BDFLAG) CALL ERROR
     +        ('ILLEGAL ENTRY POINT IN BLOCK DATA.')
            CALL XRENT(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1)
 
          ELSE IF(SYMBOL(1, I) .EQ. 2) THEN
            CALL XRCOM(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1, BDFLAG)
 
          ELSE IF(SYMBOL(1, I) .EQ. 4) THEN
            IF(.NOT. BDFLAG) CALL XVADD(PUNAME, LENP, PUNAME, LENP,
     +                                  BDFLAG, SYMBOL(1, I))
          ELSE
            IF(.NOT. BDFLAG) CALL XVADD(PUNAME, LENP, EXNAME,
     +                       LENGTH(EXNAME) + 1, BDFLAG, SYMBOL(1, I))
 
 
          ENDIF
   30   CONTINUE
 
        PU = PU + 1
 
      GO TO 10
 
      END
C---------------------------------------------------------------
C
C  FUNCTION TO ADD A COMMON BLOCK INTO THE CURRENT TABLE.
C
      SUBROUTINE XRCOM(PUNAME, LENP, COMNAM, LENC, BDFLAG)
 
      INTEGER PPOINT, CPOINT, LENP, LENC, POINT, STATUS
      INTEGER PUNAME(*), COMNAM(*), CVALS(12), JUNKV(4)
      INTEGER ZTBUPD, ZTBPUT, ZTBGET
      LOGICAL BDFLAG
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
C
C  SEARCH OUT THE ENTRY.
C
      CPOINT = ZTBGET(COMNAM, LENC, CVALS, COMARR)
      PPOINT = ZTBGET(PUNAME, LENP, JUNKV, ARRAY)
C
C  IF ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
C
      IF(CPOINT .EQ. -1) THEN
        CVALS(1) = 0
        CVALS(2) = 129
        CPOINT = ZTBPUT(COMNAM, LENC, CVALS, COMARR)
      ENDIF
 
      IF((CPOINT .EQ. -1) .OR. (CPOINT .EQ. -100))
     +   CALL ERROR('UNABLE TO ENTER COMMON NAME INTO TABLE.')
C
C  NOW CHECK TO SEE IF THE LINKED LISTS CONTAIN THE APPROPRIATE
C  INFORMATION, INSERT IT IF NOT.
C
      IF(BDFLAG) THEN
        IF(CVALS(2) .NE. 129) THEN
          CALL REMARK('COMMON BLOCK MENTIONED IN TWO BLOCK DATA PUS.')
        ENDIF
        CALL SCOPY(PUNAME, 1, CVALS, 2)
        STATUS = ZTBUPD(CPOINT, CVALS, COMARR)
        RETURN
      ENDIF
 
      IF(CVALS(1) .EQ. 0) THEN
        NUMCOM = NUMCOM + 1
        IF(NUMCOM .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
        CVALS(1) = NUMCOM
        COMLST(1, NUMCOM) = 0
        COMLST(2, NUMCOM) = PPOINT
        STATUS = ZTBUPD(CPOINT, CVALS, COMARR)
 
      ELSE
        POINT = CVALS(1)
   10   CONTINUE
          IF(COMLST(2, POINT) .EQ. PPOINT) RETURN
          IF(COMLST(1, POINT) .EQ. 0) THEN
            NUMCOM = NUMCOM + 1
            IF(NUMCOM .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
            COMLST(1, POINT)  = NUMCOM
            COMLST(1, NUMCOM) = 0
            COMLST(2, NUMCOM) = PPOINT
            RETURN
          ENDIF
 
          POINT = COMLST(1, POINT)
 
        GO TO 10
 
      ENDIF
 
      END
C---------------------------------------------------------------
C
C  OUTPUT COMMON BLOCK USAGE INFORMATION
C
      SUBROUTINE COMOUT
 
      INTEGER I, JUNK, STATUS, POINT, ENTRYS, J
      INTEGER NAME(34), VALS(12)
      INTEGER ZTBACC, ZTBTYP
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
      IF(ZTBTYP(COMARR, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
     +   ERROR('INVALID COMMON NAME TABLE.')
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following table details the usage.', OUTFD)
        CALL ZMESS('of common blocks within the specified.', OUTFD)
        CALL ZMESS('symbol table files...', OUTFD)
        CALL ZMESS('Each common block is given, followed.', OUTFD)
        CALL ZMESS('by the name of the block data program.', OUTFD)
        CALL ZMESS('unit it appears.', OUTFD)
        CALL ZMESS('in (if relevant).. $COMMON is unnamed.', OUTFD)
        CALL ZMESS('common, $BLOCKDATA is unnamed block data...', OUTFD)
      ENDIF
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) CALL ZMESS('..in +6.', OUTFD)
 
      IF(ENTRYS .EQ. 0) THEN
        CALL ZMESS('There are n'//'o common blocks used...', OUTFD)
 
      ELSE
        DO 10 I = 1, ENTRYS
          STATUS = ZTBACC(I, NAME, JUNK, VALS, COMARR)
          IF(OUTFD .NE. 1) CALL ZMESS('..ti -6.', OUTFD)
          CALL PUTLIN(NAME, OUTFD)
          J = 0
          IF(VALS(2) .EQ. 129) THEN
            CALL ZMESS (':.', OUTFD)
          ELSE
            CALL ZCHOUT(': block data - .', OUTFD)
            CALL ZPTMES(VALS(2), OUTFD)
          ENDIF
          IF(OUTFD .NE. 1) THEN
            CALL ZMESS('..br.', OUTFD)
          ELSE
            CALL ZOBLNK(6, OUTFD)
          ENDIF
 
          POINT = VALS(1)
   20     CONTINUE
            IF(POINT .EQ. 0) THEN
              CALL PUTCH(10, OUTFD)
              GO TO 10
            ENDIF
            STATUS = ZTBACC(COMLST(2, POINT), NAME, JUNK, VALS, ARRAY)
 
            IF(OUTFD .EQ. 1) THEN
              CALL PUTLIN(NAME, OUTFD)
              J = J + 1
              POINT  = COMLST(1, POINT)
              IF(POINT .EQ. 0) THEN
                CALL PUTCH(10, OUTFD)
                GO TO 20
              ELSE
                CALL PUTCH(44, OUTFD)
                IF(MOD(J, 5) .EQ. 0) THEN
                  CALL PUTCH(10, OUTFD)
                  CALL ZOBLNK(6, OUTFD)
                ENDIF
                GO TO 20
              ENDIF
 
            ELSE
              CALL PUTLIN(NAME, OUTFD)
              POINT  = COMLST(1, POINT)
              IF(POINT .NE. 0) THEN
                CALL ZMESS(',.', OUTFD)
                GO TO 20
              ELSE
                CALL PUTCH(10, OUTFD)
              ENDIF
            ENDIF
 
   10   CONTINUE
 
      ENDIF
 
      CALL COMPLT(OUTFD)
 
      END
C---------------------------------------------------------------
C
C  FUNCTION TO ADD A CALLER/CALLED PAIR INTO THE CURRENT TABLE.
C
      SUBROUTINE XRADD(CALLER, LENR, CALLED, LEND, IFLAG)
 
      INTEGER DPOINT, RPOINT, LENR, LEND, POINT, JUNK
      INTEGER CALLER(*), CALLED(*), DVALS(4), RVALS(4), JUNKV(4),
     +        JUNKA(34)
      INTEGER ZTBUPD, ZTBPUT, ZTBGET, ZTBACC
      LOGICAL DFLAG, RFLAG, IFLAG
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
C
C  SEARCH OUT THE TWO ENTRIES.
C
      DPOINT = ZTBGET(CALLED, LEND, DVALS, ARRAY)
      RPOINT = ZTBGET(CALLER, LENR, RVALS, ARRAY)
C
C  IF EITHER ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
C
      IF(RPOINT .EQ. -1) THEN
        RVALS(1) = 0
        RVALS(2) = 0
        RVALS(3) = 0
        RVALS(4) = 0
        RPOINT = ZTBPUT(CALLER, LENR, RVALS, ARRAY)
      ENDIF
      IF(DPOINT .EQ. -1) THEN
        DVALS(1) = 0
        DVALS(2) = 0
        DVALS(3) = 0
        DVALS(4) = 0
        DPOINT = ZTBPUT(CALLED, LEND, DVALS, ARRAY)
      ENDIF
 
      IF((RPOINT .EQ. -1) .OR. (RPOINT .EQ. -100) .OR.
     +   (DPOINT .EQ. -1) .OR. (DPOINT .EQ. -100))
     +   CALL ERROR('UNABLE TO ENTER SYMBOL INTO TABLE.')
C
C  NOW CHECK TO SEE IF THE LINKED LISTS CONTAIN THE APPROPRIATE
C  INFORMATION, INSERT IT IF NOT.
C
      DFLAG = .FALSE.
      RFLAG = .FALSE.
 
      IF(IFLAG) THEN
        IF(DVALS(4) .NE. -1) THEN
          DFLAG = .TRUE.
          DVALS(4) = -1
        ENDIF
      ENDIF
 
      IF(DVALS(1) .EQ. 0) THEN
        NUMCLR = NUMCLR + 1
        IF(NUMCLR .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
        DVALS(1) = NUMCLR
        CALLR(1, NUMCLR) = 0
        CALLR(2, NUMCLR) = RPOINT
        DFLAG = .TRUE.
 
      ELSE
        POINT = DVALS(1)
   10   CONTINUE
          IF(CALLR(2, POINT) .EQ. RPOINT) GO TO 15
          IF(CALLR(1, POINT) .EQ. 0) THEN
            NUMCLR = NUMCLR + 1
            IF(NUMCLR .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
            CALLR(1, POINT)  = NUMCLR
            CALLR(1, NUMCLR) = 0
            CALLR(2, NUMCLR) = RPOINT
            GO TO 15
          ENDIF
 
          POINT = CALLR(1, POINT)
 
        GO TO 10
 
      ENDIF
 
   15 CONTINUE
      IF(RVALS(2) .EQ. 0) THEN
        NUMCLD = NUMCLD + 1
        IF(NUMCLD .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
        RVALS(2) = NUMCLD
        CALLD(1, NUMCLD) = 0
        CALLD(2, NUMCLD) = DPOINT
        RFLAG = .TRUE.
 
      ELSE
C
C       CHECK TO SEE IF THIS IS AN ENTRY POINT AND GO TO THE MAIN ROUTINE IF SO
C
        IF(RVALS(2) .GT. 0) THEN
          POINT = RVALS(2)
        ELSE
          IF(ZTBACC(-RVALS(2), JUNKA, JUNK, JUNKV, ARRAY) .NE. -2)
     +       CALL ERROR('INVALID ENTRY POINT.')
          POINT = JUNKV(2)
 
        ENDIF
 
   20   CONTINUE
          IF(CALLD(2, POINT) .EQ. DPOINT) GO TO 25
          IF(CALLD(1, POINT) .EQ. 0) THEN
            NUMCLD = NUMCLD + 1
            IF(NUMCLD .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
            CALLD(1, POINT)  = NUMCLD
            CALLD(1, NUMCLR) = 0
            CALLD(2, NUMCLD) = DPOINT
            GO TO 25
          ENDIF
 
          POINT = CALLD(1, POINT)
 
        GO TO 20
 
      ENDIF
C
C  UPDATE THE ENTRIES
C
   25 CONTINUE
      IF(DFLAG) DPOINT = ZTBUPD(DPOINT, DVALS, ARRAY)
      IF(RFLAG) RPOINT = ZTBUPD(RPOINT, RVALS, ARRAY)
 
      IF((RPOINT .EQ. -1) .OR. (DPOINT .EQ. -1))
     +   CALL ERROR('AL: UNABLE TO UPDATE SYMBOL IN TABLE.')
 
      END
C---------------------------------------------------------------
C
C  FUNCTION TO ADD A PROGRAM UNIT NAME INTO THE CURRENT TABLE.
C
      SUBROUTINE XRADDP(CALLER, LENR)
 
      INTEGER RPOINT, LENR
      INTEGER CALLER(*), RVALS(4)
      INTEGER ZTBPUT, ZTBGET, ZTBUPD
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
C
C  SEARCH OUT THE ENTRY
C
      RPOINT = ZTBGET(CALLER, LENR, RVALS, ARRAY)
C
C  IF ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
C
      IF(RPOINT .EQ. -1) THEN
        RVALS(1) = 0
        RVALS(2) = 0
        RVALS(3) = 0
        RVALS(4) = 1
        RPOINT = ZTBPUT(CALLER, LENR, RVALS, ARRAY)
      ELSE
        IF(RVALS(4) .NE. 0) THEN
          CALL ERROR('AL: DUPLICATE PROGRAM UNIT NAME.')
        ELSE
          RVALS(4) = 1
          RPOINT = ZTBUPD(RPOINT, RVALS, ARRAY)
        ENDIF
      ENDIF
 
      IF((RPOINT .EQ. -1) .OR. (RPOINT .EQ. -100))
     +   CALL ERROR('AL: UNABLE TO ENTER SYMBOL INTO TABLE.')
 
      END
C---------------------------------------------------------------
C
C  ADD AN ENTRY POINT TO THE TABLE, AN ENTRY POINT IS A FORM OF
C  ALIAS TO THE SPECIFIED PU-NAME.
C
      SUBROUTINE XRENT(PUNAM, LENP, ENNAM, LENE)
 
      INTEGER LENE, LENP, PPOINT, EPOINT
      INTEGER PUNAM(*), ENNAM(*), PVALS(4), EVALS(4)
      INTEGER ZTBGET, ZTBUPD, ZTBPUT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
C
C  SEARCH OUT THE TWO ENTRIES.
C
      PPOINT = ZTBGET(PUNAM, LENP, PVALS, ARRAY)
      EPOINT = ZTBGET(ENNAM, LENE, EVALS, ARRAY)
C
C  IF EITHER ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
C
      IF(PPOINT .EQ. -1) THEN
        PVALS(1) = 0
        PVALS(2) = 0
        PVALS(3) = 0
        PVALS(4) = 1
        PPOINT = ZTBPUT(PUNAM, LENP, PVALS, ARRAY)
      ENDIF
      IF(EPOINT .EQ. -1) THEN
        EVALS(1) = 0
        EVALS(2) = 0
        EVALS(3) = 0
        EVALS(4) = 1
        EPOINT = ZTBPUT(ENNAM, LENE, EVALS, ARRAY)
      ENDIF
 
      IF((PPOINT .EQ. -1) .OR. (PPOINT .EQ. -100) .OR.
     +   (EPOINT .EQ. -1) .OR. (EPOINT .EQ. -100))
     +   CALL ERROR('UNABLE TO ENTER SYMBOL INTO TABLE.')
 
      EVALS(2) = - PPOINT
      IF(ZTBUPD(EPOINT, EVALS, ARRAY) .NE. -2) CALL
     +   ERROR('UNABLE TO UPDATE ENTRY POINT.')
 
      END
C-------------------------------------------------------------
C
C  PRODUCE A CROSS REFERENCE LISTING.
C
      SUBROUTINE LIST(FLAG)
 
      INTEGER I, STATUS, JUNK, ENTRYS, POINT, NEXT, FLAG, J
      INTEGER NAME(34), VALUES(4), JUNKS(4)
      INTEGER ZTBTYP, ZTBACC
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
 
      IF(ZTBTYP(ARRAY, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
     +   ERROR('INVALID TABLE.')
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following sub-sections show the.', OUTFD)
        CALL ZMESS('routine dependencies of those routines.',OUTFD)
        CALL ZMESS('a'//'nd entry points detailed within the.', OUTFD)
        CALL ZMESS('specified symbol table files...', OUTFD)
      ENDIF
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) CALL ZMESS('..in +10.', OUTFD)
 
      DO 10 I = 1, ENTRYS
        STATUS = ZTBACC(I, NAME, JUNK, VALUES, ARRAY)
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) CALL ZMESS('..ti -10.', OUTFD)
        CALL ZPTMES(NAME, OUTFD)
        J = 0
 
        IF(FLAG .EQ. -2) THEN
          IF(VALUES(2) .EQ. 0) THEN
            IF(OUTFD .NE. 1) THEN
              CALL ZMESS('..ti -4.', OUTFD)
            ELSE
              CALL ZOBLNK(6, OUTFD)
            ENDIF
            IF(VALUES(4) .EQ. 1) THEN
              CALL ZMESS('CALLS NOTHING:.', OUTFD)
            ELSE IF(VALUES(4) .EQ. -1) THEN
              CALL ZMESS('[Standard Intrinsic].', OUTFD)
            ELSE
              CALL ZMESS('[No Symbol Table Provided].', OUTFD)
            ENDIF
 
          ELSE
            IF(VALUES(2) .LT. 0) THEN
              IF(OUTFD .NE. 1) THEN
                CALL ZMESS('..ti -4.', OUTFD)
              ELSE
                CALL ZOBLNK(6, OUTFD)
              ENDIF
              CALL ZCHOUT('ENTRY POINT IN: .', OUTFD)
              STATUS = ZTBACC(-VALUES(2), NAME, JUNK, JUNKS, ARRAY)
              CALL ZPTMES(NAME, OUTFD)
              VALUES(2) = JUNKS(2)
 
            ELSE
              IF(OUTFD .NE. 1) THEN
                CALL ZMESS('..ti -4.', OUTFD)
                CALL ZMESS('CALLS:.', OUTFD)
              ELSE
                CALL ZOBLNK(6, OUTFD)
                CALL ZMESS('CALLS:.', OUTFD)
                CALL ZOBLNK(10, OUTFD)
              ENDIF
 
              POINT = VALUES(2)
   15         CONTINUE
                NEXT  = CALLD(2, POINT)
                STATUS = ZTBACC(NEXT, NAME, JUNK, JUNKS, ARRAY)
                CALL PUTLIN(NAME, OUTFD)
                J = J + 1
                POINT = CALLD(1, POINT)
                IF(POINT .NE. 0) THEN
                  CALL ZCHOUT(', .', OUTFD)
                  IF(MOD(J, 5) .EQ. 0) THEN
                    CALL PUTCH(10, OUTFD)
                    IF(OUTFD .EQ. 1) CALL ZOBLNK(10, OUTFD)
                  ENDIF
                  GO TO 15
                ENDIF
                CALL PUTCH(10, OUTFD)
            ENDIF
          ENDIF
        ENDIF
 
        J = 0
        IF(VALUES(1) .EQ. 0) THEN
          IF(OUTFD .NE. 1) THEN
            CALL ZMESS('..ti -4.', OUTFD)
          ELSE
            CALL ZOBLNK(6, OUTFD)
          ENDIF
          CALL ZMESS('NOT CALLED.', OUTFD)
        ELSE
          IF(OUTFD .NE. 1) THEN
            CALL ZMESS('..ti -4.', OUTFD)
          ELSE
            CALL ZOBLNK(6, OUTFD)
          ENDIF
          CALL ZMESS('CALLED BY:.', OUTFD)
          IF(OUTFD .EQ. 1) CALL ZOBLNK(10, OUTFD)
          POINT = VALUES(1)
   25     CONTINUE
            NEXT  = CALLR(2, POINT)
            STATUS = ZTBACC(NEXT, NAME, JUNK, JUNKS, ARRAY)
            CALL PUTLIN(NAME, OUTFD)
            J = J + 1
            POINT = CALLR(1, POINT)
            IF(POINT .NE. 0) THEN
              CALL ZCHOUT(', .', OUTFD)
              IF(MOD(J, 5) .EQ. 0) THEN
                CALL PUTCH(10, OUTFD)
                IF(OUTFD .EQ. 1) CALL ZOBLNK(10, OUTFD)
              ENDIF
              GO TO 25
            ENDIF
            CALL PUTCH(10, OUTFD)
        ENDIF
 
   10 CONTINUE
 
      CALL COMPLT(OUTFD)
 
      END
C-----------------------------------------------------------------
C
C  FUNCTION TO READ A DYNAMIC EXECUTION FILE (CURRENT OR HISTORY)
C
      SUBROUTINE GETDYN(ENDST)
 
      INTEGER I, STATUS, POINT, NOSEGS, ENDST
      INTEGER BUFFER(134)
      INTEGER GETLIN, CTOI, OPEN
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      ENDST = -1
      IF(DYNFD .EQ. -2) THEN
        ENDST = -2
        RETURN
      ENDIF
 
      DYNFD = OPEN(DYNNAM, 0)
      IF(DYNFD .EQ. -1) THEN
        CALL REPORT('UNABLE TO OPEN RUN TIME FILE.', OUTFD)
        RETURN
      ENDIF
 
      NOSEGS = 0
      NOASRT = 0
 
      STATUS = GETLIN(BUFFER, DYNFD)
      IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
        CALL CLOSE(DYNFD)
        DYNFD = -2
        CALL CALC
        ENDST = -2
        RETURN
      ENDIF
      I = 1
      NOSEGS = CTOI(BUFFER, I)
      IF(NOSEGS .GT. MAXSEG) THEN
        CALL REPORT('TOO MANY SEGMENTS.', OUTFD)
        RETURN
      ENDIF
      POINT  = 1
 
   10 CONTINUE
        IF(POINT .LE. NOSEGS) THEN
          STATUS = GETLIN(BUFFER, DYNFD)
          IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
            CALL CLOSE(DYNFD)
            DYNFD = -2
            CALL CALC
            ENDST = -2
            RETURN
          ENDIF
          IF(DEBUG) CALL ZMESS('---IN ROUTINE: GETDYN---.', 1)
          DO 20 I = 1, 121, 8
            IF(POINT .GT. NOSEGS) GO TO 10
            SEGS (POINT) = 10000000 * (BUFFER(I)   - 48)
     +                   + 1000000  * (BUFFER(I+1) - 48)
     +                   + 100000   * (BUFFER(I+2) - 48)
     +                   + 10000    * (BUFFER(I+3) - 48)
     +                   + 1000     * (BUFFER(I+4) - 48)
     +                   + 100      * (BUFFER(I+5) - 48)
     +                   + 10       * (BUFFER(I+6) - 48)
     +                   +            (BUFFER(I+7) - 48)
            IF(DEBUG) THEN
              CALL PUTDEC(SEGS(POINT), 1)
              CALL SKIP(1)
            ENDIF
            POINT = POINT + 1
   20     CONTINUE
          GO TO 10
 
        ENDIF
 
      STATUS = GETLIN(BUFFER, DYNFD)
      IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
        CALL CLOSE(DYNFD)
        DYNFD = -2
        CALL CALC
        ENDST = -2
        RETURN
      ENDIF
      I = 1
      NOASRT = CTOI(BUFFER, I)
      IF(NOASRT .GT. MAXASR) THEN
        CALL REPORT('TOO MANY ASSERTIONS.', OUTFD)
        RETURN
      ENDIF
      POINT  = 1
 
   30 CONTINUE
        IF(POINT .LE. NOASRT) THEN
          STATUS = GETLIN(BUFFER, DYNFD)
          IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
            CALL CLOSE(DYNFD)
            DYNFD = -2
            CALL CALC
            ENDST = -2
            RETURN
          ENDIF
          DO 40 I = 1, 121, 8
            IF(POINT .GT. NOASRT) GO TO 30
            ASRTS(POINT) = 10000000 * (BUFFER(I)   - 48)
     +                   + 1000000  * (BUFFER(I+1) - 48)
     +                   + 100000   * (BUFFER(I+2) - 48)
     +                   + 10000    * (BUFFER(I+3) - 48)
     +                   + 1000     * (BUFFER(I+4) - 48)
     +                   + 100      * (BUFFER(I+5) - 48)
     +                   + 10       * (BUFFER(I+6) - 48)
     +                   +            (BUFFER(I+7) - 48)
            POINT = POINT + 1
   40     CONTINUE
         GO TO 30
 
        ELSE
          CALL CLOSE(DYNFD)
          DYNFD = -2
          CALL CALC
          ENDST = -2
        ENDIF
 
      END
C----------------------------------------------------------
C
      SUBROUTINE CALC
 
      INTEGER I, J, K, START, END, NUMB
      INTEGER GETLIM
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
C
C  CALCULATE THE DYNAMIC STATEMENT TYPE FREQUENCIES
C
      DO 10 I = 1, NUMROU
        NUMB = GETLIM(I, START, END)
        DO 20 J = 1, LMAXG
          DTOTAL(J, I) = 0
          DO 25 K = START, END
            IF(K .NE. 0) DTOTAL(J, I) = DTOTAL(J, I) +
     +                                  SEGS(K) * COUNTS(J, K)
   25     CONTINUE
   20   CONTINUE
 
   10 CONTINUE
C
C  MAKE UP THE PROGRAM TOTALS
C
      IF(DEBUG) CALL ZMESS('---IN ROUTINE: CALC---.', 1)
      DO 30 I = 1, LMAXG
        DTOTAL(I, MAXPRO) = 0
        DO 40 J = 1, NUMROU
          DTOTAL(I, MAXPRO) = DTOTAL(I, MAXPRO) + DTOTAL(I, J)
   40   CONTINUE
        IF(DEBUG) THEN
          CALL PUTDEC(DTOTAL(I, MAXPRO),1)
          CALL SKIP(1)
        ENDIF
   30 CONTINUE
 
      END
C -----------------------------------------------------------------
C
C  READ STATEMENT TYPE SUMMARY FILE AND PROCESS INFORMATION.
C
      SUBROUTINE RSTATS(ENDST)
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
      INTEGER   I, CURSEG, CURENT, NTYSEG, TYPE, POINT, LIMIT, J,
     +          STATUS, IL, ENDST
      INTEGER   BUFFER(134)
      INTEGER   GETLIN, CTOI, OPEN
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      ENDST = -1
      IF(SUMFD .EQ. -2) THEN
        ENDST = -2
        RETURN
      ENDIF
 
      SUMFD = OPEN(SUMNAM, 0)
      IF(SUMFD .EQ. -1) THEN
        CALL REPORT('UNABLE TO OPEN SUMMARY FILE.', OUTFD)
        RETURN
      ENDIF
 
      DO 10 I = 1, LMAXG
        PTOTAL(I) = 0
   10 CONTINUE
C
      CURENT = 1
 
   20 CONTINUE
C
C  READ CURRENT ROUTINE NAME, STARTING SEGMENT NUMBER,
C  AND STARTING ASSERTION NUMBER
C
      STATUS = GETLIN(BUFFER, SUMFD)
      IF(STATUS .EQ. -100) THEN
        CALL CLOSE(SUMFD)
        SUMFD = -2
        NUMROU = CURENT - 1
        NUMSEG = CURSEG - 1
        ENDST = -2
        RETURN
      ENDIF
      DO 1 I = 1, 6
        NAMES(I, CURENT) = BUFFER(I)
    1 CONTINUE
      NAMES(I, CURENT) = 129
      ISTSEG(CURENT)  = CTOI(BUFFER, I)
      ISTASG(CURENT)  = CTOI(BUFFER, I)
      CURSEG          = ISTSEG(CURENT)
      IF(CURSEG .NE. 0) THEN
C
C  READ A SEGMENT RECORD WHICH CONTAINS:
C  NO. PAIRS, (STMT TYPE, NO. OCCUR.,IL=1,NO. PAIRS)
C
        IF(DEBUG) CALL ZMESS('---IN ROUTINE: RSTATS---.', 1)
   40   CONTINUE
        DO 39 I = 1, LMAXG
          COUNTS(I, CURSEG) = 0
   39   CONTINUE
        STATUS = GETLIN(BUFFER, SUMFD)
        IF(BUFFER(1) .NE. 42) THEN
          NTYSEG = 10 * (BUFFER(1) - 48) + BUFFER(2) - 48
          DO 41 IL = 1, NTYSEG
            POINT = (IL - 1) * 5 + 3
            TYPE         = 10  * (BUFFER(POINT)   - 48)
     +                   +        BUFFER(POINT+1) - 48
            COUNTS(TYPE, CURSEG) = 100 * (BUFFER(POINT+2) - 48)
     +                           + 10  * (BUFFER(POINT+3) - 48)
     +                           +        BUFFER(POINT+4) - 48
            IF(DEBUG) THEN
              CALL PUTDEC(POINT,  5)
              CALL PUTDEC(TYPE,   5)
              CALL PUTDEC(CURSEG, 5)
              CALL PUTDEC(COUNTS(TYPE, CURSEG), 5)
              CALL SKIP(1)
            ENDIF
   41     CONTINUE
          CURSEG = CURSEG + 1
          IF(CURSEG .GT. MAXSEG) CALL ERROR('TOO MANY SEGMENTS.')
          GO TO 40
        END IF
 
      ELSE
C  SKIP THE STARS ON A BLOCK DATA ENTRY
        STATUS = GETLIN(BUFFER, SUMFD)
      ENDIF
C
C  READ ROUTINE SUMMARY RECORD WHICH CONTAINS:
C    61 ENTRIES IN 4 RECORDS OF 16, 16, 16 AND 13 VALUES EACH.
C
      DO 51 I = 1, 4
        LIMIT = 16
        IF(I .EQ. 4) LIMIT = 13
        STATUS = GETLIN(BUFFER, SUMFD)
        DO 52 J = 1, LIMIT
          POINT = (I-1) * 16 + J
          RTOTAL(POINT, CURENT) = 10000 * (BUFFER((J-1)*5+1)-48)
     +                          + 1000  * (BUFFER((J-1)*5+2)-48)
     +                          + 100   * (BUFFER((J-1)*5+3)-48)
     +                          + 10    * (BUFFER((J-1)*5+4)-48)
     +                          +          BUFFER((J-1)*5+5)-48
          PTOTAL(POINT) = PTOTAL(POINT) + RTOTAL(POINT, CURENT)
   52   CONTINUE
   51 CONTINUE
 
      CURENT = CURENT + 1
      IF(CURENT .LE. MAXROU) GO TO 20
      CALL ERROR('TOO MANY ROUTINES.')
 
      END
C----------------------------------------------------------------
C
C  PRODUCE A STATIC SUMMARY LISTING
C
      SUBROUTINE PROLST(COMAND)
 
      INTEGER I, JUNK, FIRST
      INTEGER COMAND(*)
      INTEGER ZPFIND, ZSETP
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      JUNK = ZSETP(COMAND, CASFOL)
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('This table contains a count of the.', OUTFD)
        CALL ZMESS('statements in the specified program unit,.', OUTFD)
        CALL ZMESS('split by statement type...', OUTFD)
      ENDIF
      CALL PUTCH(10, OUTFD)
 
      IF(COMAND(1) .EQ. 129) THEN
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
        CALL ZCHOUT('STATIC SUMMARY TOTAL FOR FILE: .', OUTFD)
        CALL ZPTMES(SUMNAM, OUTFD)
        CALL ZCHOUT(' (.', OUTFD)
        CALL ZPTINT(NUMROU, 1, OUTFD)
        CALL ZMESS (' PROGRAM UNITS)...', OUTFD)
        CALL STREPS(PTOTAL)
      ELSE IF(COMAND(1) .NE. 32) THEN
        DO 10 I = 1, NUMROU
          IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
            IF(FIRST .EQ. 1) THEN
              CALL PUTCH(10, OUTFD)
              IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
              CALL ZCHOUT('STATIC SUMMARY FOR PROGRAM UNIT: .', OUTFD)
              CALL ZPTMES(NAMES(1, I), OUTFD)
              CALL STREPS(RTOTAL(1, I))
            ENDIF
          ENDIF
   10   CONTINUE
      ENDIF
 
      END
C----------------------------------------------------------------
C
C  PRODUCE A DYNAMIC SUMMARY LISTING
C
      SUBROUTINE DYNLST(COMAND)
 
      INTEGER I, JUNK, FIRST
      INTEGER COMAND(*)
      INTEGER ZSETP, ZPFIND
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      INTEGER ANNFD,  DYNFD,  SUMFD
      INTEGER ANNNAM(81), DYNNAM(81),
     +        SUMNAM(81)
 
      COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
     +                 ANNFD,  DYNFD,  SUMFD
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      JUNK = ZSETP(COMAND, CASFOL)
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('This table contains a count of the.', OUTFD)
        CALL ZMESS('statements actually executed in the.', OUTFD)
        CALL ZMESS('specified program unit,.', OUTFD)
        CALL ZMESS('split by statement type...', OUTFD)
      ENDIF
      CALL PUTCH(10, OUTFD)
 
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..nf.', OUTFD)
        CALL ZMESS('..nj.', OUTFD)
      ENDIF
 
      IF(COMAND(1) .EQ. 129) THEN
        CALL PUTCH(10, OUTFD)
        IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
        CALL ZCHOUT('DYNAMIC SUMMARY TOTALS FOR FILE: .', OUTFD)
        CALL ZPTMES(SUMNAM, OUTFD)
        CALL ZCHOUT(' (.', OUTFD)
        CALL ZPTINT(NUMROU, 1, OUTFD)
        CALL ZMESS (' PROGRAM UNITS)...', OUTFD)
        CALL DYREPS(DTOTAL(1, MAXPRO))
      ELSE IF(COMAND(1) .NE. 32) THEN
        DO 10 I = 1, NUMROU
          IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
            IF(FIRST .EQ. 1) THEN
              CALL PUTCH(10, OUTFD)
              IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
              CALL ZCHOUT('DYNAMIC SUMMARY FOR PROGRAM UNIT: .', OUTFD)
              CALL ZPTMES(NAMES(1, I), OUTFD)
              CALL DYREPS(DTOTAL(1, I))
            ENDIF
          ENDIF
   10   CONTINUE
      ENDIF
 
      END
C -------------------------------------------------------------
C
C  OUTPUT DYNAMIC STATEMENT TYPES REPORT
C
      SUBROUTINE DYREPS(IOUTA)
C
      INTEGER     IOUTA(*)
      INTEGER     IFL,IGOTOL
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C     .. Scalars in Common ..
      INTEGER     KAGOG,
     +            KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,KCFUNG,
     +            KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +            KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +            KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,
     +            KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,
     +            KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,
     +            KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,KSUBRG,KUFUNG,
     +            KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,LCMNTG,LERRG,
     +            LLINEG,LSTMTG
C     ..
C     .. Common blocks ..
      COMMON      /KEYSC/KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,
     +            KCALLG,KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,
     +            KCONTG,KDATAG,KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,
     +            KENDFG,KENDG,KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,
     +            KIMPLG,KINQRG,KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,
     +            KNONEG,KNTRYG,KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,
     +            KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,
     +            KSUBRG,KUFUNG,KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,
     +            LCMNTG,LERRG,LLINEG,LSTMTG
C     ..
      SAVE
 
C     .. Executable Statements ..
      IFL     = IOUTA(KAIFG) + IOUTA(KBIFG) + IOUTA(KLIFG)
      IGOTOL  = IOUTA(KAGOG) + IOUTA(KCGOG) + IOUTA(KUGOG)
 
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..ce 15.', OUTFD)
        CALL ZMESS('..in 0.', OUTFD)
        CALL ZMESS('..nf.', OUTFD)
        CALL ZMESS('..nj.', OUTFD)
      ENDIF
      CALL PUTCH(10, OUTFD)
      CALL OUTFM1(IOUTA(KASSNG),IFL,'ASSIGN','IF')
      CALL OUTFM1(IOUTA(KBACKG),IOUTA(KAIFG),'BACKSPACE',
     +                                                 '--(ARITHMETIC)')
      CALL OUTFM1(IOUTA(KCALLG),IOUTA(KBIFG),'CALL','--(BLOCK)')
      CALL OUTFM1(IOUTA(KCLOSG),IOUTA(KLIFG),'CLOSE','--(LOGICAL)')
      CALL OUTFM1(IOUTA(KCONTG),IOUTA(KINQRG),'CONTINUE','INQUIRE')
      CALL OUTFM1(IOUTA(KDOG),IOUTA(KOPENG),'DO','OPEN')
      CALL OUTFM1(IOUTA(KELSFG),IOUTA(KPAUSG),'ELSE IF','PAUSE')
      CALL OUTFM1(IOUTA(KELSEG),IOUTA(KPRNTG),'ELSE','PRINT')
      CALL OUTFM1(IOUTA(KENDFG),IOUTA(KREADG),'ENDFILE','READ')
      CALL OUTFM1(IOUTA(KENDIG),IOUTA(KRETNG),'END IF','RETURN')
      CALL OUTFM1(IOUTA(KENDG),IOUTA(KWINDG),'END','REWIND')
      CALL OUTFM1(IGOTOL,IOUTA(KSTOPG),'GO TO','STOP')
      CALL OUTFM1(IOUTA(KAGOG),IOUTA(KWRITG),'--(ASSIGNED)','WRITE')
      CALL OUTFM1(IOUTA(KCGOG),IOUTA(KASMTG),'--(COMPUTED)',
     +                                        '(ASSIGNMENT STATEMENTS)')
      CALL OUTFM1(IOUTA(KUGOG),IOUTA(KNONEG),'--(UNCONDITIONAL)',
     +                                      '(UNRECOGNIZED STATEMENTS)')
      CALL COMPLT(OUTFD)
 
      END
C -----------------------------------------------------------------
C
C  OUTPUT STATIC STATEMENT TYPES REPORT
C
      SUBROUTINE STREPS(IOUTA)
C
C     .. Array Arguments ..
      INTEGER     IOUTA(*)
C     ..
C     .. Local Scalars ..
      INTEGER     IFL,IFUNCL,IGOTOL
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C     .. Scalars in Common ..
      INTEGER     KAGOG,
     +            KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,KCFUNG,
     +            KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +            KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +            KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,
     +            KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,
     +            KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,
     +            KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,KSUBRG,KUFUNG,
     +            KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,LCMNTG,LERRG,
     +            LLINEG,LSTMTG
C     ..
C     .. Common blocks ..
      COMMON      /KEYSC/KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,
     +            KCALLG,KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,
     +            KCONTG,KDATAG,KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,
     +            KENDFG,KENDG,KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,
     +            KIMPLG,KINQRG,KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,
     +            KNONEG,KNTRYG,KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,
     +            KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,
     +            KSUBRG,KUFUNG,KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,
     +            LCMNTG,LERRG,LLINEG,LSTMTG
C     ..
      SAVE
C     ..
C     .. Executable Statements ..
      IFL     = IOUTA(KAIFG)  + IOUTA(KBIFG)  + IOUTA(KLIFG)
      IFUNCL  = IOUTA(KCFUNG) + IOUTA(KXFUNG) + IOUTA(KDFUNG) +
     +          IOUTA(KIFUNG) + IOUTA(KLFUNG) + IOUTA(KRFUNG) +
     +          IOUTA(KUFUNG)
      IGOTOL  = IOUTA(KAGOG)  + IOUTA(KCGOG)  + IOUTA(KUGOG)
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..ce 5.', OUTFD)
        CALL ZMESS('..nf.', OUTFD)
        CALL ZMESS('..nj.', OUTFD)
        CALL ZMESS('..in 0.', OUTFD)
      ENDIF
      CALL ZCHOUT('ASSERTIONS: .', OUTFD)
      CALL ZPTINT(IOUTA(LASRTG), 5, OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL ZCHOUT('COMMENTS  : .', OUTFD)
      CALL ZPTINT(IOUTA(LCMNTG), 5, OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL ZCHOUT('ERRORS    : .', OUTFD)
      CALL ZPTINT(IOUTA(LERRG), 5, OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL ZCHOUT('TOKENS    : .', OUTFD)
      CALL ZPTINT(IOUTA(LLINEG), 5, OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL ZCHOUT('STATEMENTS: .', OUTFD)
      CALL ZPTINT(IOUTA(LSTMTG), 5, OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL PUTCH(10, OUTFD)
 
      IF(OUTFD .NE. 1) CALL ZMESS('..ce 30.', OUTFD)
      CALL OUTFM1(IOUTA(KASSNG),IGOTOL,'ASSIGN','GO TO')
      CALL OUTFM1(IOUTA(KBACKG),IOUTA(KAGOG),'BACKSPACE','--(ASSIGNED)')
      CALL OUTFM1(IOUTA(KBLOKG),IOUTA(KCGOG),'BLOCK DATA',
     +'  (COMPUTED)')
      CALL OUTFM1(IOUTA(KCALLG),IOUTA(KUGOG),'CALL','--(UNCONDITIONAL)')
      CALL OUTFM1(IOUTA(KCHARG),IFL,'CHARACTER','IF')
      CALL OUTFM1(IOUTA(KCLOSG),IOUTA(KAIFG),'CLOSE','--(ARITHMETIC)')
      CALL OUTFM1(IOUTA(KCOMNG),IOUTA(KBIFG),'COMMON','--(BLOCK)')
      CALL OUTFM1(IOUTA(KCMPXG),IOUTA(KLIFG),'COMPLEX','LOGICAL')
      CALL OUTFM1(IOUTA(KCONTG),IOUTA(KIMPLG),'CONTINUE','IMPLICIT')
      CALL OUTFM1(IOUTA(KDATAG),IOUTA(KINQRG),'DATA','INQUIRE')
      CALL OUTFM1(IOUTA(KDIMNG),IOUTA(KINTEG),'DIMENSION','INTEGER')
      CALL OUTFM1(IOUTA(KDBLEG),IOUTA(KINSCG),'DOUBLE PRECISION',
     +                                                      'INTRINSIC')
      CALL OUTFM1(IOUTA(KDOG),IOUTA(KLOGCG),'DO','LOGICAL')
      CALL OUTFM1(IOUTA(KELSFG),IOUTA(KOPENG),'ELSE IF','OPEN')
      CALL OUTFM1(IOUTA(KELSEG),IOUTA(KPARAG),'ELSE','PARAMETER')
      CALL OUTFM1(IOUTA(KENDFG),IOUTA(KPAUSG),'ENDFILE','PAUSE')
      CALL OUTFM1(IOUTA(KENDIG),IOUTA(KPRNTG),'END IF','PRINT')
      CALL OUTFM1(IOUTA(KENDG),IOUTA(KPROGG),'END','PROGRAM')
      CALL OUTFM1(IOUTA(KNTRYG),IOUTA(KREADG),'ENTRY','READ')
      CALL OUTFM1(IOUTA(KEQIVG),IOUTA(KREALG),'EQUIVALENCE','REAL')
      CALL OUTFM1(IOUTA(KEXTLG),IOUTA(KRETNG),'EXTERNAL','RETURN')
      CALL OUTFM1(IOUTA(KFORMG),IOUTA(KWINDG),'FORMAT','REWIND')
      CALL OUTFM1(IFUNCL,IOUTA(KSAVEG),'FUNCTION','SAVE')
      CALL OUTFM1(IOUTA(KCFUNG),IOUTA(KSTOPG),'--CHARACTER','STOP')
      CALL OUTFM1(IOUTA(KXFUNG),IOUTA(KSUBRG),'--COMPLEX','SUBROUTINE')
      CALL OUTFM1(IOUTA(KDFUNG),IOUTA(KWRITG),'--DOUBLE PRECISION',
     +                                                          'WRITE')
      CALL OUTFM1(IOUTA(KIFUNG),IOUTA(KASMTG),'--INTEGER',
     +                                        '(ASSIGNMENT STATEMENTS)')
      CALL OUTFM1(IOUTA(KLFUNG),IOUTA(KSFUNG),'--LOGICAL',
     +                                          '(STATEMENT FUNCTIONS)')
      CALL OUTFM1(IOUTA(KRFUNG),IOUTA(KNONEG),'--REAL',
     +                                      '(UNRECOGNIZED STATEMENTS)')
      CALL OUTFM1(IOUTA(KUFUNG),0,'--UNTYPED','-')
 
      CALL COMPLT(OUTFD)
C
      END
C -----------------------------------------------------------------
C
C  NEW ROUTINE TO OUTPUT THINGS ACCORDING TO THE FORMATS USED IN
C  THE ROUTINE STREPS.
C
      SUBROUTINE OUTFM1(VAL1, VAL2, STR1, STR2)
 
      INTEGER       VAL1, VAL2, CHARS, GUTTER
      CHARACTER*(*) STR1, STR2
      INTRINSIC     LEN
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
      GUTTER = RMARG - 68
      IF(GUTTER .GT. 10) GUTTER = 10
      IF(GUTTER .LT.  2) GUTTER = 2
 
      CHARS = LEN(STR1)
      CALL ZCHOUT(STR1, OUTFD)
      CALL ZPTINT(VAL1, 25 - CHARS + 8, OUTFD)
 
      CALL ZOBLNK(GUTTER, OUTFD)
      CHARS = LEN(STR2)
      CALL ZCHOUT(STR2, OUTFD)
      CALL ZPTINT(VAL2, 25 - CHARS + 8, OUTFD)
 
      CALL PUTCH(10, OUTFD)
 
      END
C-------------------------------------------------------------
C
C  OUTPUT A CALLGRAPH
C
      SUBROUTINE GRAPH
 
      INTEGER    MAXLVL
      PARAMETER (MAXLVL = 15)
 
      INTEGER ENTRYS, JUNK, I, LEVEL, ROOT, STATUS, LINE,
     +        POINT, INDEX
      INTEGER VALUES(4), NAME(34), STACK(0:MAXLVL), NEWVAL(4)
      INTEGER ZTBTYP, ZTBACC, ZTBUPD
      LOGICAL EMPTY, PUSHED
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
 
      IF(ZTBTYP(ARRAY, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
     +   ERROR('INVALID TABLE.')
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following callgraph shows the.', OUTFD)
        CALL ZMESS('routine dependencies of those routines.',OUTFD)
        CALL ZMESS('an'//'d entry points detailed within the.', OUTFD)
        CALL ZMESS('specified symbol table files...', OUTFD)
        CALL ZMESS('Where an entry is followed by a.', OUTFD)
        CALL ZMESS('nu'//'mber in brackets, the n'//'umber.', OUTFD)
        CALL ZMESS('refers to the line on which that.', OUTFD)
        CALL ZMESS('entry''s expansion has already been.', OUTFD)
        CALL ZMESS('shown.. If a name is followed by a.', OUTFD)
        CALL ZMESS('question mark, this indicates that.', OUTFD)
        CALL ZMESS('the routines symbol table was n'//'ot.', OUTFD)
        CALL ZMESS('provided...', OUTFD)
        CALL PUTCH(10, OUTFD)
      ENDIF
C
C  CLEAR ALL THE FLAGS (2 CALLGRAPHS MAY BE REQUESTED FROM THE SAME
C  DATA).
C
      DO 100 I = 1, ENTRYS
        STATUS = ZTBACC(I, NAME, JUNK, VALUES, ARRAY)
        VALUES(3) = 0
        STATUS = ZTBUPD(I, VALUES, ARRAY)
  100 CONTINUE
 
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..nf.', OUTFD)
        CALL ZMESS('..nj.', OUTFD)
      ENDIF
 
      LINE = 1
C
C  FIND OUT IF THERE ARE ANY ELEMENTS IN THE TREE WHICH HAVE YET TO
C  BE OUTPUT. IF THERE ARE THEN FIND A TREE ROOT (IF NONE THEN THERE
C  IS RECURSION).
C
   20 CONTINUE
      ROOT  = 0
      EMPTY = .TRUE.
      DO 10 I = 1, ENTRYS
        STATUS = ZTBACC(I, NAME, JUNK, VALUES, ARRAY)
        IF(VALUES(3) .EQ. 0) THEN
          IF(VALUES(1) .EQ. 0) THEN
            ROOT = I
            GO TO 15
          ENDIF
          EMPTY = .FALSE.
        ENDIF
   10 CONTINUE
 
      IF(EMPTY) THEN
        CALL COMPLT(OUTFD)
      ELSE
        CALL REPORT('SUB-TREE CONTAINS NO ROOT (RECURSIVE).', OUTFD)
      END IF
      RETURN
C
C  PROCESS A SUB-TREE
C
   15 CONTINUE
      LEVEL = 0
      POINT = ROOT
      CALL PUTCH(10, OUTFD)
 
   30 CONTINUE
 
        STATUS = ZTBACC(POINT, NAME, JUNK, VALUES, ARRAY)
        IF(ROOT .EQ. POINT) THEN
          IF(VALUES(2).NE.0) THEN
            INDEX = CALLD(1, VALUES(2))
          ELSE
            INDEX=0
          ENDIF
        ENDIF
        PUSHED = .FALSE.
 
        CALL ZPTINT(LINE, 4, OUTFD)
        CALL ZOBLNK(LEVEL * 4 + 2, OUTFD)
        CALL PUTLIN(NAME, OUTFD)
        IF(VALUES(4) .EQ. 0) THEN
          CALL ZCHOUT(' (?).', OUTFD)
        ELSE IF(VALUES(4) .EQ. -1) THEN
          CALL ZCHOUT(' (Std.. Intrinsic).', OUTFD)
        ENDIF
 
        IF(VALUES(3) .EQ. 0) THEN
 
          VALUES(3) = LINE
          STATUS    = ZTBUPD(POINT, VALUES, ARRAY)
 
          IF(VALUES(2) .EQ. 0) THEN
            LINE = LINE + 1
            CALL PUTCH(10, OUTFD)
 
          ELSE IF(VALUES(2) .LT. 0) THEN
            CALL ZCHOUT(' (ENTRY: .', OUTFD)
            STATUS = ZTBACC(-VALUES(2), NAME, JUNK, NEWVAL, ARRAY)
            CALL PUTLIN(NAME, OUTFD)
            CALL ZCHOUT(' @ .', OUTFD)
            CALL ZPTINT(NEWVAL(3), 1, OUTFD)
            LINE = LINE + 1
            CALL ZMESS (').', OUTFD)
 
          ELSE
            IF(LEVEL .GT. MAXLVL) THEN
              CALL REPORT('TOO COMPLEX.', OUTFD)
              RETURN
            ENDIF
            STACK(LEVEL) = INDEX
            LEVEL = LEVEL + 1
            INDEX = VALUES(2)
            LINE = LINE + 1
            CALL PUTCH(10, OUTFD)
 
          ENDIF
 
        ELSE
          IF(VALUES(2) .NE. 0) THEN
            CALL ZCHOUT(' (.', OUTFD)
            CALL ZPTINT(VALUES(3), 1, OUTFD)
            LINE = LINE + 1
            CALL ZMESS (').', OUTFD)
          ELSE
            LINE = LINE + 1
            CALL PUTCH(10, OUTFD)
          ENDIF
 
        ENDIF
 
   22   CONTINUE
        IF(INDEX .EQ. 0) THEN
   23     CONTINUE
            IF(LEVEL .LE. 1) GO TO 20
            LEVEL = LEVEL - 1
            INDEX = STACK(LEVEL)
          IF(INDEX .EQ. 0) GO TO 23
        ENDIF
        POINT = CALLD(2, INDEX)
        INDEX = CALLD(1, INDEX)
        IF(POINT .EQ. 0) GO TO 22
 
      GO TO 30
 
      END
C--------------------------------------------------------------
C
C  PRODUCE A TOTALS SUMMARY LISTING
C
      SUBROUTINE TOTLST(COMAND)
 
      INTEGER I, JUNK, FIRST
      INTEGER COMAND(*)
      INTEGER ZSETP, ZPFIND
      LOGICAL FLAG
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      JUNK = ZSETP(COMAND, CASFOL)
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        CALL ZMESS('The following table gives information.',OUTFD)
        CALL ZMESS('derived from the static a'//'nd dynamic.',OUTFD)
        CALL ZMESS('statistics specified...',OUTFD)
      ENDIF
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS ('..nf.', OUTFD)
        CALL ZMESS ('..nj.', OUTFD)
        CALL ZMESS ('..ul.', OUTFD)
        CALL ZMESS ('..ce.', OUTFD)
      ENDIF
      CALL ZMESS ('SUMMARY TOTALS.', OUTFD)
      CALL PUTCH(10, OUTFD)
      CALL ZMESS(
     +'---PROGRAM UNIT---  ------STATEMENTS-------   ---SEGMENTS-----'
     +,OUTFD)
      CALL ZMESS(
     +'        INVOCATION  TOTAL  EXEC-    PERCENT   TOTAL   PERCENT '
     +,OUTFD)
      CALL ZMESS(
     +'NAME    FREQUENCY   NUMBER   UTABLE EXECUTED  NUMBER  EXECUTED'
     +,OUTFD)
      CALL ZMESS(
     +'--------------------------------------------------------------'
     +,OUTFD)
      DO 10 I = 1, NUMROU
        IF(ZPFIND(NAMES(1, I), 1, FIRST,  JUNK) .EQ. -2) THEN
          FLAG = .TRUE.
          IF(FIRST .NE. 1) FLAG = .FALSE.
        ELSE
          FLAG = .FALSE.
        ENDIF
        CALL TOREPS(I, FLAG)
   10 CONTINUE
 
      CALL TOREPS(0, .TRUE.)
      CALL COMPLT(OUTFD)
 
      END
C--------------------------------------------------------------
C
      SUBROUTINE TOREPS(I, FLAG)
 
      INTEGER I, J, K, COUNT, FIRST, LAST
      INTEGER VAL(6), TOT(6), CUM(2)
      LOGICAL FLAG
      INTEGER GETLIM
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C     .. Scalars in Common ..
      INTEGER     KAGOG,
     +            KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,KCFUNG,
     +            KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +            KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +            KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,
     +            KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,
     +            KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,
     +            KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,KSUBRG,KUFUNG,
     +            KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,LCMNTG,LERRG,
     +            LLINEG,LSTMTG
C     ..
C     .. Common blocks ..
      COMMON      /KEYSC/KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,
     +            KCALLG,KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,
     +            KCONTG,KDATAG,KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,
     +            KENDFG,KENDG,KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,
     +            KIMPLG,KINQRG,KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,
     +            KNONEG,KNTRYG,KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,
     +            KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,
     +            KSUBRG,KUFUNG,KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,
     +            LCMNTG,LERRG,LLINEG,LSTMTG
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      IF(I .EQ. 1) THEN
        DO 5 J = 1, 6
          TOT(J) = 0
    5   CONTINUE
        CUM(1) = 0
        CUM(2) = 0
      ENDIF
 
      IF(I .EQ. 0) THEN
        IF(FLAG) THEN
          CALL PUTCH(10, OUTFD)
          CALL ZCHOUT('-TOTAL .', OUTFD)
          TOT(4) = 0
          TOT(6) = 0
          IF(TOT(5) .NE. 0) THEN
            TOT(6) = (100 * CUM(2)) / TOT(5)
          ELSE
            TOT(4) = 0
          ENDIF
          IF(TOT(3) .NE. 0) THEN
            TOT(4) = (100 * CUM(1)) / TOT(3)
          ELSE
            TOT(4) = 0
          ENDIF
          DO 10 J = 1, 6
            CALL ZPTINT(TOT(J), 9, OUTFD)
   10     CONTINUE
          CALL PUTCH (10, OUTFD)
        ENDIF
      ELSE
        IF(FLAG) CALL PUTLIN(NAMES(1, I), OUTFD)
        VAL(2) = RTOTAL(LSTMTG, I)
        VAL(5) = GETLIM(I, FIRST, LAST)
        IF(VAL(5) .EQ. 0) THEN
          IF(FLAG) CALL ZOBLNK(10, OUTFD)
          IF(FLAG) CALL ZPTINT(VAL(2), 9, OUTFD)
          TOT(2) = TOT(2) + VAL(2)
          IF(FLAG) CALL ZMESS('  -- block data --.', OUTFD)
          RETURN
        ENDIF
        VAL(1) = SEGS(FIRST)
        VAL(3) = 0
        VAL(4) = 0
        VAL(6) = 0
        DO 100 J = ISTSEG(I), LAST
          IF(SEGS(J) .NE. 0) THEN
            COUNT = 0
            DO 200 K = 1, 56
              COUNT = COUNT + COUNTS(K,J)
  200       CONTINUE
            VAL(4) = VAL(4) + COUNT
            VAL(6) = VAL(6) + 1
          ENDIF
 
          VAL(3) = VAL(3)            +COUNTS(KASSNG,J)+COUNTS(KBACKG,J)+
     +             COUNTS(KCALLG , J)+COUNTS(KCLOSG,J)+COUNTS(KCONTG,J)+
     +             COUNTS(KDOG,J)+    COUNTS(KELSFG,J)+COUNTS(KELSEG,J)+
     +             COUNTS(KENDFG,J)+  COUNTS(KENDIG,J)+COUNTS(KENDG,J)+
     +             COUNTS(KUGOG,J)+   COUNTS(KLIFG,J)+ COUNTS(KINQRG,J)+
     +             COUNTS(KOPENG,J)+  COUNTS(KPAUSG,J)+COUNTS(KPRNTG,J)+
     +             COUNTS(KREADG,J)+  COUNTS(KRETNG,J)+COUNTS(KWINDG,J)+
     +             COUNTS(KSTOPG,J)+  COUNTS(KWRITG,J)+COUNTS(KAGOG,J)+
     +             COUNTS(KCGOG,J)+   COUNTS(KAIFG,J)+ COUNTS(KBIFG,J)+
     +             COUNTS(KASMTG,J)
  100   CONTINUE
        CUM(1) = CUM(1) + VAL(4)
        CUM(2) = CUM(2) + VAL(6)
        IF(VAL(5) .NE. 0) THEN
          VAL(6) = (100 * VAL(6)) / VAL(5)
        ELSE
          VAL(6) = 0
        ENDIF
        IF(VAL(3) .NE. 0) THEN
          VAL(4) = (100 * VAL(4)) / VAL(3)
        ELSE
          VAL(4) = 0
        ENDIF
        IF(FLAG) CALL ZOBLNK(1, OUTFD)
          DO 20 J = 1, 6
            IF(FLAG) THEN
              CALL ZPTINT(VAL(J), 9, OUTFD)
            ENDIF
            TOT(J) = TOT(J) + VAL(J)
   20     CONTINUE
        IF(FLAG) CALL PUTCH (10, OUTFD)
      ENDIF
 
      END
C-----------------------------------------------------------
C
C RETURN THE FIRST AND LAST SEGMENT NUMBERS FOR THE SPECIFIED
C ROUTINE, ALSO THE VALUE OF THE FUNCTION IS THE NUMBER OF SEGMENTS.
C
      INTEGER FUNCTION GETLIM(ROUTIN, FIRST, LAST)
 
      INTEGER ROUTIN, FIRST, LAST, I
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C     .. Parameters ..
C
C  MAXSEG     The maximum number of segments that can be held in memory
C  MAXROU     The maximum number of routines that can be held in memory
C
 
      INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
      PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
      PARAMETER(MAXPRO= MAXROU + 1)
C     ..
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
C
C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
C             THE STATIC SUMMARY)
C
C  NAMES      THE NAMES OF THE ROUTINES
C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
C             IN EACH ROUTINE).
C
 
      INTEGER NUMROU, NUMSEG, NOASRT
      INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
     +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
     +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
 
      COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
     +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
      SAVE
 
      FIRST = ISTSEG(ROUTIN)
      IF(FIRST .EQ. 0) THEN
        LAST   = 0
        GETLIM = 0
        RETURN
      ENDIF
 
      IF(ROUTIN .EQ. NUMROU) THEN
        LAST = NUMSEG
      ELSE
        I = 1
   10   CONTINUE
          LAST = ISTSEG(ROUTIN + I) - 1
          IF(LAST .LT. 0) THEN
            I = I + 1
            IF(ROUTIN + I .LE. NUMROU) GO TO 10
            LAST = NUMSEG
          ENDIF
 
      ENDIF
 
      GETLIM = LAST - FIRST + 1
 
      END
C---------------------------------------------------------------
C
C  FUNCTION TO ADD A NON PU REFERENCE TO THE VARIABLE TABLE
C
      SUBROUTINE XVADD(PUNAME, LENP, COMNAM, LENC, BDFLAG, BVALS)
 
      INTEGER PPOINT, CPOINT, LENP, LENC, I
      INTEGER PUNAME(*), COMNAM(*), VVALS(12), JUNKV(4), BVALS(*),
     +        NAME(34)
      INTEGER ZTBGET, ZTBPUT
      LOGICAL BDFLAG
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
C
C  SEARCH OUT THE PROGRAM UNIT ENTRY.
C
      PPOINT = ZTBGET(PUNAME, LENP, JUNKV, ARRAY)
      IF((PPOINT .EQ. -1) .OR. (PPOINT .EQ. -100))
     +   CALL ERROR('UNABLE TO FIND PROGRAM UNIT NAME IN TABLE.')
C
C  SET UP THE VARIABLE ENTRY, THE NAME IS PRECEDED BY A POINTER TO THE
C  PROGRAM UNIT (FOR UNIQUENESS) AND THE SYMBOL VALUES (PLUS A MODIFIED BLOCK
C  DATA FLAG) ARE STORED IN THE TABLE.
C
      NAME(1) = PPOINT
      DO 10 I = 1, 7
        VVALS(I) = BVALS(I)
   10 CONTINUE
      CALL SCOPY(COMNAM,1,NAME,2)
      VVALS(8) = 0
      IF(BDFLAG) VVALS(8) = 1
 
      CPOINT = ZTBPUT(NAME, LENC+1, VVALS, VARARR)
      IF((CPOINT .EQ. -1) .OR. (CPOINT .EQ. -100))
     +   CALL ERROR('UNABLE TO ENTER VARIABLE NAME INTO TABLE.')
 
      END
C-------------------------------------------------------------
C
C  PRODUCE A SYMBOL OR WARNING LISTING.
C
      SUBROUTINE VLIST(SHOW, BODY)
 
      INTEGER JUNK, ENTRYS, SHOW, NAMLEN, FIRST, I, KEYLEN, STATUS
      INTEGER BODY(*), KEY(34), VALUES(8), JUNKS(10), NAME(34)
      INTEGER ZTBTYP, ZSETP, ZTBACC, ZPFIND
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
 
      IF(ZTBTYP(VARARR, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
     +   ERROR('INVALID TABLE.')
 
      IF(BODY(1) .EQ. 129) RETURN
      JUNK = ZSETP(BODY, CASFOL)
 
      IF(VERBOS) THEN
        CALL PUTCH(10, OUTFD)
        IF(SHOW .EQ. -2) THEN
          CALL ZMESS('The following table shows the symbol.',OUTFD)
          CALL ZMESS('usage for the specified program units...',OUTFD)
        ELSE
          CALL ZMESS('The following table shows warnings.',OUTFD)
          CALL ZMESS('derived from the symbol tables of the.',OUTFD)
          CALL ZMESS('specified program units...',OUTFD)
        ENDIF
      ENDIF
 
      CALL PUTCH(10, OUTFD)
      IF(OUTFD .NE. 1) THEN
        CALL ZMESS('..nf.', OUTFD)
        CALL ZMESS('..nj.', OUTFD)
      ENDIF
 
      I  = 1
   10 CONTINUE
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        STATUS = ZTBACC(KEY(1), NAME, NAMLEN, JUNKS, ARRAY)
        IF(ZPFIND(NAME, 1, FIRST, JUNK) .EQ. -2) THEN
          IF(FIRST .EQ. 1) THEN
            IF(SHOW .EQ. -2) THEN
             CALL ZCHOUT
     +       ('Symbol table information for program u'//'nit: .',OUTFD)
            ELSE
              CALL ZCHOUT('Warnings for program u'//'nit: .',OUTFD)
            ENDIF
            CALL ZPTMES(NAME, OUTFD)
            CALL DOVARS(I, SHOW, ENTRYS)
            CALL PUTCH(10, OUTFD)
          ENDIF
        ENDIF
        I = I + 1
      IF(I .LE. ENTRYS) GO TO 10
 
      CALL COMPLT(OUTFD)
 
      END
C---------------------------------------------------------------
C
      SUBROUTINE DOVARS(POINT, FLAG, LIMIT)
 
      INTEGER POINT, FLAG, FIRST, LAST, KEYLEN, COUNT, STATUS, I, PU,
     +        LIMIT, MASK
      INTEGER KEY(34), VALUES(8)
      INTEGER ZTBACC, ZIAND
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
 
      FIRST = POINT
      LAST  = POINT - 1
      STATUS = ZTBACC(FIRST, KEY, KEYLEN, VALUES, VARARR)
      PU = KEY(1)
   10 CONTINUE
        LAST = LAST + 1
        IF(LAST .LE. LIMIT) THEN
          STATUS = ZTBACC(LAST + 1, KEY, KEYLEN, VALUES, VARARR)
          IF((KEY(1) .EQ. PU) .AND. (STATUS .EQ. -2))GO TO 10
        ENDIF
C
C  WARNING SECTION
C
      IF(FLAG .EQ. -3) THEN
        MASK  = 16 + 32 + 64 + 128 +
     +          65536 + 4 + 2048
 
        COUNT = 0
        DO 20 I = FIRST, LAST
          STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
          IF(VALUES(8) .EQ. 1)  GO TO 20
          IF(VALUES(1) .EQ. 1) THEN
            IF(VALUES(5) + VALUES(6) +
     +         VALUES(7) .EQ. 0) THEN
              COUNT = COUNT + 1
              CALL ZCHOUT('  Unused Label: .', OUTFD)
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ENDIF
 
          ELSE IF(VALUES(1) .EQ. 3) THEN
              COUNT = COUNT + 1
              IF(ZIAND(VALUES(6), 4) .NE. 0) THEN
                CALL ZCHOUT('  Unused dummy argument: ', OUTFD)
              ELSE
                CALL ZCHOUT('  Unused symbol: ', OUTFD)
              ENDIF
              CALL WRNAME(KEY, VALUES, .TRUE.)
 
          ELSE IF(VALUES(1) .EQ. 5) THEN
            IF((ZIAND(VALUES(6), 125936) .EQ. 0) .AND.
     +         (ZIAND(VALUES(6), 1024) .EQ. 0)) THEN
              COUNT = COUNT + 1
              CALL ZCHOUT('  Unused Variable: .', OUTFD)
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ELSE IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
              IF(IMPLI) THEN
                CALL ZCHOUT('  Implicitly typed Variable: .', OUTFD)
                COUNT = COUNT + 1
                CALL WRNAME(KEY, VALUES, .TRUE.)
              ENDIF
            ELSE IF(ZIAND(VALUES(6), MASK) .EQ. 0 .AND.
     +         (ZIAND(VALUES(6), 1024) .EQ. 0)) THEN
              CALL ZCHOUT('  Variable n'//'ot explicitly set: .', OUTFD)
              COUNT = COUNT + 1
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ENDIF
 
          ELSE IF(VALUES(1) .EQ. 8) THEN
            IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
              COUNT = COUNT + 1
              CALL ZCHOUT('  Unused Statement Function: .', OUTFD)
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ELSE IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
              IF(IMPLI) THEN
                COUNT = COUNT + 1
                CALL ZCHOUT
     +               ('  Implicitly typed Statement Function: .', OUTFD)
                CALL WRNAME(KEY, VALUES, .TRUE.)
              ENDIF
            ENDIF
 
          ELSE IF(VALUES(1) .EQ. 6) THEN
            IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
              CALL ZCHOUT('  Unused Parameter: .', OUTFD)
              COUNT = COUNT + 1
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ELSE IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
              IF(IMPLI) THEN
                CALL ZCHOUT('  Implicitly typed Parameter: .', OUTFD)
                COUNT = COUNT + 1
                CALL WRNAME(KEY, VALUES, .TRUE.)
              ENDIF
            ENDIF
 
          ELSE IF(VALUES(1) .EQ. 7) THEN
            IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
              CALL ZCHOUT('  Unused Procedure: .', OUTFD)
              COUNT = COUNT + 1
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ELSE
              IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
                IF(ZIAND(VALUES(6), 4096) .EQ. 0)THEN
                  IF(ZIAND(VALUES(6), 8192) .NE. 0)THEN
                    IF(IMPLI) THEN
                      CALL ZCHOUT
     +                     ('  Implicitly typed Procedure: .', OUTFD)
                      COUNT = COUNT + 1
                      CALL WRNAME(KEY, VALUES, .TRUE.)
                    ENDIF
                  ENDIF
                ENDIF
              ELSE
                IF(ZIAND(VALUES(6), 4096) .NE. 0)THEN
                  CALL ZCHOUT('  Typed Standard Intrinsic: .', OUTFD)
                  COUNT = COUNT + 1
                  CALL WRNAME(KEY, VALUES, .TRUE.)
                ENDIF
              ENDIF
              IF(ZIAND(VALUES(6), 4096) .NE. 0) THEN
                IF(ZIAND(VALUES(6), 2) .EQ. 0)THEN
                  CALL ZCHOUT
     +         ('  Intrinsic procedure n'//'ot in INTRINSIC: .', OUTFD)
                  COUNT = COUNT + 1
                  CALL WRNAME(KEY, VALUES, .TRUE.)
                ENDIF
              ELSE IF(ZIAND(VALUES(6), 1).EQ.0)THEN
                CALL ZCHOUT
     +         ('  External procedure n'//'ot in EXTERNAL: .', OUTFD)
                COUNT = COUNT + 1
                CALL WRNAME(KEY, VALUES, .TRUE.)
              ENDIF
            ENDIF
 
          ELSE IF(VALUES(1) .EQ. 4) THEN
            IF(FIRST .GE. LAST) THEN
              CALL ZCHOUT('  Trivial program unit: .', OUTFD)
              COUNT = COUNT + 1
              CALL WRNAME(KEY, VALUES, .TRUE.)
            ENDIF
            IF(VALUES(4) .GT. 0) THEN
              IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
                CALL ZCHOUT('  Function value n'//'ot set: .', OUTFD)
                COUNT = COUNT + 1
                CALL WRNAME(KEY, VALUES, .TRUE.)
              ENDIF
            ENDIF
          ENDIF
   20   CONTINUE
        IF(COUNT .EQ. 0) CALL ZMESS('  No Warnings Detected...', OUTFD)
 
      ELSE
C
C  SYMBOL USAGE INFORMATION
C
        CALL PRINTS(FIRST, LAST, 1)
 
      ENDIF
 
      POINT = LAST
 
      END
C-------------------------------------------------
C
C       P R I N T S   -   Print Symbols
C
C  ORDER = 1   LEAVE THE LABELS IN THE CURRENTLY SORTED ORDER
C  ORDER = 2   SORT THE LABELS NUMERICALLY
C  ORDER = 3   OUTPUT THE LABELS IN THE ORDER OF THEIR DEFINITION NODES.
C
 
      SUBROUTINE PRINTS(FIRST, LAST, ORDER)
 
      INTEGER FIRST, LAST, KEYLEN, COUNT, STATUS, I, J,
     +        ORDER, LABELS
      INTEGER KEY(34), VALUES(8), TABLE(3, 500)
      INTEGER ZTBACC, CTOI
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
C  AND XREFERENCE GENERATION ROUTINES.
C
C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
C
C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
C
C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLD(2, X)   THE TABLE ENTRY.
C
C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
C  CALLR(2, X)   THE TABLE ENTRY.
C
C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
C         OF PROGRAM UNITS THAT REFERENCE THEM.
C  COMLST THE LINKED LIST OF USERS.
C
      INTEGER MAXSIZ, MAXENT, MAXVAR
      PARAMETER (MAXVAR = 30720)
      PARAMETER (MAXSIZ = 2048)
      PARAMETER (MAXENT = 1024)
 
      INTEGER NUMCLD, NUMCLR, NUMCOM
      INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
     +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
 
      COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
     +               NUMCLR, NUMCLD, NUMCOM
      SAVE
 
      LABELS = 0
      DO 9 I = FIRST, LAST
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        IF (VALUES(1).EQ.1) THEN
          LABELS = LABELS + 1
          TABLE(1, LABELS) = VALUES(4)
          TABLE(2, LABELS) = I
          J = 1
          TABLE(3, LABELS) = CTOI(KEY, J)
        ENDIF
    9 CONTINUE
C
C  A SORTING AGORITHM SHOULD BE PLACED HERE THAT CAN USE EITHER
C  TABLE(1...) OR TABLE(3...) AS A KEY
C
C      IF(ORDER .NE. 1) THEN
C      ENDIF
 
      COUNT = 0
      DO 10 I = 1, LABELS
        STATUS = ZTBACC(TABLE(2, I), KEY, KEYLEN, VALUES, VARARR)
        IF(COUNT .EQ. 0) CALL ZMESS('        Labels:.',OUTFD)
        COUNT = COUNT + 1
        CALL ZOBLNK(12, OUTFD)
        CALL WRNAME(KEY, VALUES, .FALSE.)
        CALL ZOBLNK(8 - KEYLEN, OUTFD)
        CALL ZCHOUT('- References (control,do,i/o): .',OUTFD)
        CALL ZPTINT(VALUES(5),1,OUTFD)
        CALL PUTCH(44,OUTFD)
        CALL ZPTINT(VALUES(6),1,OUTFD)
        CALL PUTCH(44,OUTFD)
        CALL ZPTINT(VALUES(7),1,OUTFD)
        CALL PUTCH(10,OUTFD)
   10 CONTINUE
 
      COUNT = 0
      DO 20 I = FIRST, LAST
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        IF (VALUES(1).EQ.3) THEN
            IF(COUNT .EQ. 0)
     +         CALL ZMESS('        Names (Usage Unknown):.',OUTFD)
            COUNT = COUNT + 1
            CALL ZOBLNK(12,OUTFD)
            CALL WRNAME(KEY, VALUES, .FALSE.)
            CALL PUTCH(10,OUTFD)
            CALL WRBITS(VALUES(6))
        END IF
   20 CONTINUE
 
      COUNT = 0
      DO 30 I = FIRST, LAST
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        IF (VALUES(1).EQ.5) THEN
            IF(COUNT .EQ. 0)CALL ZMESS('        Variables:.',OUTFD)
            COUNT = COUNT + 1
            CALL ZOBLNK(12,OUTFD)
            CALL WRNAME(KEY, VALUES, .FALSE.)
            IF (VALUES(7).NE.0) THEN
                 CALL ZMESS('(declared as an array).',OUTFD)
            ELSE
                CALL PUTCH(10, OUTFD)
            END IF
            CALL WRBITS(VALUES(6))
        END IF
   30 CONTINUE
 
      COUNT = 0
      DO 40 I = FIRST, LAST
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        IF (VALUES(1).EQ.6) THEN
            IF(COUNT .EQ. 0) CALL ZMESS('        Parameters:.',OUTFD)
            COUNT = COUNT + 1
            CALL ZOBLNK(12,OUTFD)
            CALL WRNAME(KEY, VALUES, .FALSE.)
            CALL PUTCH(10, OUTFD)
            CALL WRBITS(VALUES(6))
        END IF
   40 CONTINUE
 
      COUNT = 0
      DO 50 I = FIRST, LAST
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        IF (VALUES(1).EQ.7) THEN
            IF(COUNT .EQ. 0) CALL ZMESS('        Procedures:.',OUTFD)
            COUNT = COUNT + 1
            CALL ZOBLNK(12,OUTFD)
            CALL WRNAME(KEY, VALUES, .FALSE.)
            CALL PUTCH(10,OUTFD)
            CALL WRBITS(VALUES(6))
        END IF
   50 CONTINUE
 
      COUNT = 0
      DO 60 I = FIRST, LAST
        STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
        IF (VALUES(1).EQ.8) THEN
            IF(COUNT .EQ. 0)
     +        CALL ZMESS('        Statement Functions:.',OUTFD)
            COUNT = COUNT + 1
            CALL ZOBLNK(12,OUTFD)
            CALL WRNAME(KEY, VALUES, .TRUE.)
            CALL WRBITS(VALUES(6))
        END IF
   60 CONTINUE
 
        END
C ------------------------------------------------
C
C       W R N A M E   -   Write symbol name and data type if any
C
 
      SUBROUTINE WRNAME(NAME, SYMBOL, END)
      INTEGER NAME(*), SYMBOL(*)
      CHARACTER*17 TYPTXT(-3:15)
      LOGICAL TEST1, TEST2, END
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
        DATA TYPTXT/
     +'Main Program.    ',
     +'Block-data.      ',
     +'Routine.         ',
     +'Unknown.         ',
     +'INTEGER.         ',
     +'REAL.            ',
     +'LOGICAL.         ',
     +'COMPLEX.         ',
     +'DOUBLE PRECISION.',
     +'CHARACTER.       ',
     +'DOUBLE COMPLEX.  ',
     +'Generic.         ',
     +'Hollerith.       ',
     +'Label.           ',
     +'Substring spec.  ',
     +'LOGICAL*1.       ',
     +'LOGICAL*2.       ',
     +'INTEGER*2.       ',
     +'REAL*16.         '/
 
      CALL PUTLIN(NAME(2),OUTFD)
      CALL ZLEGAL(NAME(2), TEST1, TEST2)
 
      IF (SYMBOL(1).EQ.1) RETURN
      IF (SYMBOL(1).EQ.2) GO TO 10
 
      CALL ZCHOUT(' - .',OUTFD)
      CALL ZCHOUT(TYPTXT(SYMBOL(4)),OUTFD)
      IF (SYMBOL(5).NE.0) THEN
        CALL PUTCH(42,OUTFD)
        IF (SYMBOL(5).GT.0) THEN
          CALL ZPTINT(SYMBOL(5),1,OUTFD)
        END IF
      END IF
 
   10 CONTINUE
      IF(TEST1) THEN
        IF(TEST2) CALL PUTCH(32,OUTFD)
        IF(.NOT.TEST2)CALL ZCHOUT(' (Name illegal on -11) .',OUTFD)
      ELSE
        IF(.NOT.TEST2)CALL ZCHOUT(' (Name illegal) .', OUTFD)
        IF(TEST2)CALL ZCHOUT(' (Name non-standard) .',OUTFD)
      ENDIF
 
      IF(END) CALL PUTCH(10,OUTFD)
 
      END
C ------------------------------------------------
C
C       W R B I T S   -   Write meaning of attribute bits
C
 
      SUBROUTINE WRBITS(N)
 
      INTEGER      BITS,I, N, NBITS
      PARAMETER (NBITS=22)
      CHARACTER*50 BITTXT(NBITS)
      INTEGER      ZIAND
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
      LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
      INTEGER OUTFD,  RMARG, REPRTS
 
      COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
     +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
      SAVE
 
        DATA (BITTXT(I),I=1,19)/
     +'                Declared EXTERNAL.                ',
     +'                Declared INTRINSIC.               ',
     +'                Formal parameter.                 ',
     +'                Explicitly typed.                 ',
     +'                In ASSIGN statement.              ',
     +'                Assigned to on lhs of "=".        ',
     +'                In READ input list.               ',
     +'                In DATA statement.                ',
     +'                Statement function formal param.  ',
     +'                In EQUIVALENCE statement.         ',
     +'                In COMMON block.                  ',
     +'                Used as an actual argument.       ',
     +'                Standard intrinsic function.      ',
     +'                Called as a function.             ',
     +'                In an expression.                 ',
     +'                Called as a subroutine.           ',
     +'                Used as a DO-loop index.          ',
     +'                Actual argument to external.      ',
     +'                Parameter value known.            '/
        DATA (BITTXT(I),I=20,NBITS)/
     +'                Equivalenced into a common block. ',
     +'                *** unassigned flag bit ***.      ',
     +'                In INCLUDE file.                  '/
 
      BITS = N
      DO 100 I = 1, NBITS
        IF (ZIAND(BITS, 1) .NE. 0) CALL ZMESS(BITTXT(I), OUTFD)
        BITS = BITS/2
 100  CONTINUE
 
      END
